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;;-*- mode: lisp: package: cadr ~*~ 

;Production check out aids. Those are mostly for freshly constructed machines 
; before CC-TEST-MACHINE can even do anything reasonable. 

Check: dummy in 5A19 

Check both ends of high runs: 
CADR 

HI1 1F05(3) 4F25(8) 

HI2 1FQ5(4) 4A27(7) 

HI3 1F05(5) 4E24(9) 

HI4 1F05(6) 4E24(11) 

HI5 1F05(7) 4E24(12) 

HI6 1FQ5(8) 4E24(13) 

HI7 1F06(9) 4E24(14) 

HIS 1F05(12) 4E29(7) 

HI9 1F06(13) 4E29(8) 

III10 1F05(14) 4E29(9) 

Hill 1BQ5(19) 4E29(11) 

HI12 1F05(16) 4E29(12) 
ICMEM 

HI1 1F01(8) 1A18(5) 

HI2 1F06(3) 1A19(17) 

;Verify Reset getting from bus interface to processor 

; DEBUGEE RESET L. busint A16(12) 

; BUSINT LM RESET L busint C04(ll) 

; BUSINT J08(13) --lots of stuff has to work for this to happen -- 

; -BUSINT. LM. RESET icmem 6AJ1-U 

;(P~RESET-LQOP) 
(DEFUN P-RESET-LOOP NIL 
(DO () (())■ (DBG-RESET))) 

(DEFUN P-RESET-MACH () 

(DO () {(KBD-TYI-NO-HANG)) 
(CC-RESET-MACH) 
(CC-NQOP-DEBUG-CLOCK'))) 

(DEFUN P-START-STOP (^OPTIONAL (SPEED 0)) 

(DO () ((KBD-TYI-NO~HANG)) 
(CC-RESET-MACH) 
(CC-EXECUTE C0NS-IR-M-5RC CONS-M-SRC-MD 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-M+1 

CONS-IR-FUNC-DEST CONS~FUNC~DEST~MD) 
(SPY-WRITE SPY-MODE (LOGAND 3 SPEED)) ;set speed, clear errstop, etc, 
(SPY-WRITE SPY-CLK 11) ;aet run and debug 

(PROCESS-SLEEP 1.) 
(SPY-WRITE SPY-CLK 10) 
(CC-READ-M-MEM CONS-M-SRC-MD) )) 



-DB NEEDS UB BUSINT D01-8 

8US REQ BUSINT D05-6 

NPR BUSINT D10-6 

DB UB MASTER BUSINT D04-12 

SELECT DEBUG BUSINT E07-8 

SPY WRITE L BUSINT J08-10 

-DBWRITE SF03(6) SPYO 6AJ1-10 MBCPIN 
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;-LDBIRH 5F03(15) SPYO 5F15(11) DEBUG 

;-LDBIRM 5F03(16) SPYO 5E12(11) DEBUG 

;-LDBIRL 5F03(17) SPYO 5E14(11) DEBUG 

;DIAG IR (1F15.1E11) (1E12.1E13) (1E14.1E15) DEBUG print 

; clock -LDDBIRL 11:15(11) 

; output enable -IDEBUG 1E15(1) 

; SPYO 1E15(18) 10 1E15(19) 

;(P-DBG-IR-L00P) 

(DEFUN P-DBG-IR-LOOP (&0PTI0NAL (N 0)) 

(DO ((NOT-N (LOGXOR N 7777777777777777))) 
((KBD-TYI-NO-HANG)) 
(CC-WRITE-IR N) (CC-WRITE-IR NOT-N))) 

;PC 4E04.4E05 NPC print 

; CLK4B 4E05(11), PCO 4E05(19) 

(DEFUN P-PC-LOOP (^OPTIONAL (N 0)) 
(DO () (()) (CC-WRITE-PC N))) 

(DEFUN P-PC-R--LOOP NIL 

(DO () (()) (CC-READ-PC))) 

(DEFUN P-IR-LOOP (^OPTIONAL (N 0)) 
(DO () (()) (CC-WRITE-IR N))) 

(DEFUN P-TEST-UNIBUS-MAP (&AUX TEM) 
(DOTIMES (A 20) 

(DOLIST (V '(0 177777 125252 052525)) 
(DBG-WRITE-UNIBUS-MAP A V) 
(COND ((NOT (- (SETQ TEM (DBG-READ-UNIBUS-MAP A)) V)) 

(FORMAT T "-"/.Unibus map locn -s, wrote ~s, read ~s" A V TEM))))) 
(DBG-RESET)) ;1et console prgm know it has to remap 

(DEFUN P-UBM-LOOP (&0PTI0NAL (D -1) (A 0)) 
(DO () (()) 

(DBG-WRITE-UNIBUS-MAP A D))) 

(DEFUN P-UBM-R-LOOP (&0PTI0NAL (A 0)) ; 
(DO () (()) 

(DBG-READ-UNIBUS-MAP A))) 

;XBUS TERMINATOR INI 

;UB TO MD L BUSINT D12(ll) BUSINT REQU 
;UB MD LOAD BUSINT B17(16) BUSINT REQLM 
;-LOADMD BUSINT ClO(ll) BUSINT REQLM 
5-LOADMD 1C01-19 BCPINS 
;LOADMD 1D18(11) MD 
;MDCLK 1E19(11) MD 
(DEFUN P-MD-LOOP (&OPTIONAL (N 0)) 
(DO () (()) (CC-WRITE-MD N))) 

(DEFUN P-MD-R-LOOP NIL 

(DO () (()) (CC-READ-MD))) 

(DEFUN CC-TEST-MD (&OPTIONAL (N 0) (M -1)) 
(DO () ((KBD-TYI-NO-HANG)) 
(CC-WRITE-MD N) 
(CC-READ-MD) 
(CC-WRITE-MD M) 
(CC-READ-MD))) 

(DEFUN P-MD-SMFTING-LOOP (&OPTIONAL (N 0)) 

(DO () (()) (CC-WRITE-MD-SHIFTING N))) ; 

(DEFUN CC-TEST-VMA (&OPTIONAL (N 0) (M -1)) 
(DO () ((KBD~TYI-N0~HAN6)) 
(CC-WRITE-VMA N) 
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(CC-READ-VMA) 
(CC-WRITE-VMA M) 
(CC-READ-VMA))) 

(DEFUN P-VMA-LOOP (&OPTIONAL (N 0)) 
(DO (()) (CC-WRITE-VMA N))) 

(DEFUN P-OBUS-LOOP NIL 

(DO () (()) (CC-READ-OBUS))) 

(defun p-m-rw-m-pass (n &optiona1 (adr 0)) 

(CC-WRITE-MD n) ;PUT VALUE INTO THE MRD REGISTER 

(CC-EXECUTE ;NOTE NO WRITE, JUST PUT IT IN IR 

CONS-IR-M-SRC CONS-M-SRC-MD 

CONS-IR-ALUF CONS-ALU-SETM 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-M-MEM-DEST adr) 
(CC-EXECUTE (EXECUTOR CC-EXECUTE-LOAD-DEBUG-IR) 

CONS-IR-M-SRC ADR ; PUT IT ONTO THE OBUS 

CONS-IR-ALUF CONS-ALU-SETM 

CONS-IR-OB CONS-OB-ALU) 
(CC-DEBUG-CLOCK) ; EXECUTE THE WRITE, LOAD IR WITH THE READ 
(CC-READ-OBUS)) ;READ BACK THE DATA VIA THE PASS AROUND PATH 

(DEFUN P-M-MEM-LOOP (&OPTIONAL (N 0) (ADR 0)) 
(DO () (()) (CC-WRITE-M-MEM ADR N))) 

(DEFUN P-M-MEM-R-LOOP (&OPTIONAL (ADR 0)) 
(DO () (()) (CC-READ-M-MEM ADR))) 

(DEFUN P-M-MEM-RW-LOOP (&OPTIONAL (N 0) (ADR 0)) 
(DO () (()) 

(CC-WRITE-M-MEM ADR N) 
(CC-READ-M-MEM ADR) j) 

(DEFUN P-A-MEM-LOOP (&OPTIONAL (N 0) (ADR 0)) 
(DO () (()) (CC-WRITE-A-MEM ADR N))) 1 

(DEFUN P-A-MEM-R-LOOP (&OPTIONAL (ADR 0)) 
(DO () (()) (CC-READ-A-MEM ADR))) 

(DEFUN P-PDL-BUFFER-WR-LOOP (&OPTIONAL (ADR 0) (VAL1 0) (VAL2 -1)) 
(DO () (()) 

(CC-WRITE-PDL-BUFFER ADR VAL1) 
(CC-READ-PDL-BUFFER ADR) 
(CC-WRITE-PDL-BUFFER ADR VAL2) 
(CC-READ-PDL-BUFFER VAL2))) 

(defun p-m-rw-a~pass (n &optiona1 (adr 0)) 

(CC-WRITE-MD n) ;PUT VALUE INTO THE MRD REGISTER 

(CC-EXECUTE " ;NOTE NO WRITE, JUST PUT IT IN IR 

CONS-IR-M-SRC CONS-M-SRC-MD ;MOVE IT TO DESIRED PLACE 

CONS-IR-ALUF CONS-ALU-SETM 

'CONS-IR-OB CONS-OB-ALU 

CONS-IR-A-MEM-DEST (+ CONS-A-MEM-DEST-INDICATOR adr)) 
(CC-EXECUTE (EXECUTOR CC-EXECUTE-LOAD-DEBUG-IR) 

CONS-IR-A-SRC ADR ;PUT IT ONTO THE OBUS 

CONS-IR-ALUF CONS-ALU-SETA 

CONS-IR-OB CONS-OB-ALU) 
(CC-DEBUG-CLOCK) ; EXECUTE THE WRITE, LOAD IR WITH THE READ 
(CC-READ-OBUS)) ;READ BACK THE DATA VIA THE PASS AROUND PATH 

(DEFUN P-C-MEM-LOOP (&OPTIONAL (N 0) (ADR 0)) 
(DO () (()) (CC-WRITE-C-MEM ADR N))) 

(DEFUN P-C-MEM-R-LOOP (&OPT10NAL (ADR 0)) 
(DO () (()) (CC-READ-C-MEM ADR))) 
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(DEFUN P-C-MEM-WR-LOOP (^OPTIONAL (ADR 0) (VAL1 0) (VAL2 -1)) 
(DO () (()) 

(CC-WRITE-C-MEM ADR VAL1) 
(CC-READ-C-MEM ADR) 
(CC-WRITE-C-MEM ADR VAL2) 
(CC-READ-C-MEM ADR))) 

(defun p-lc-wr-loop (&optional (nl 0) (nZ -1)) 
(do () (()) 

(cc-write~1c nl) 
(cc-read-le) 
(cc-write-'lc n2) 
(cc-read-lc))) 

(DEFUN P-LC-LOOP (&OPTIONAL (N 0)) 

(DO () (()) .(CC-WRITE-FUNC-DEST CONS-FUN'C-DEST-LC N))) 

(DEFUN P-INTC-LOOP (&OPTIONAL (N 0)) 

(DO () (()) (CC-WRITE-FUNC-DEST CONS-FUNC-DEST-INT-CNTRL N))) 

(DEFUN P-D-MEM-LOOP (&OPTIONAL (VAL 0) (ADR 0)) 
(do () ((KBD-TYI-NO-HANG)) 
(P-D-MEM-D VAL ADR))) 

(DEFUN P-D-MEM-ADR NIL 

(DO ((I 1 (IF (> I 2000) 1 (LSH I 1)})) 
((KBD-TYI-NO-HANG)) 
(P-D-MEM-D (+ RADMO I)) 
(P-D-MEM-D -1. (+ RADMO I)))) 

(DEFUN P-D-MEM-D (VAL ADR) 
(CC-WRITE-A-MEM 

(LOGDPB-INTO-FIXNUM (DO ((COUNT 17. (1- COUNT)) 

(X VAL, (LOGXOR VAL (LSH X -1)))) 
((- COUNT 0) 
(LOGXOR 1 X))) ;ODD PARITY 
CONS-DISP-PARITY-BIT 

VAL)) ;DATA TO BE WRITTEN TO A-LOC 

(CC-EXECUTE CONS-IR-OP CONS-OP-DISPATCH 
CONS-IR-A-SRC 
C0NS-IR-D1SP-ADDR ADR 
- CONS-IR-MF 2) ;MF2 IS WRITE D-MEM 
;GENERATE A CLOCK FOLLOWED BY A WRITE PULSE, WITHOUT CHANGING IR 
;NOTE THAT WRITING D MEM IS DIFFERENT FROM WRITING ANYTHING ELSE 
;BECAUSE THE WRITE IS NOT DELAYED, BUT DOES USE WP . 
(CODEBUG-CLOCK)) ;PUT INSTRUCTION IN DIB AND IR 

;Load IR with Dispatch inst. D-MEM contents should appear statically 
; on D-MEM data lines 

(DEFUN P-D-EXAM (&OPTIONAL (LOC 0)) 

(CC-EXECUTE CONS-IR-OP CONS-OP-DISPATCH ; EXECUTE A DISPATCH WITH BYTE SIZE ZERO 
CONS-IR-DISP-ADDR LOC)) 

(DEFUN P-MN-MEM-LOOP (&OPTIONAL (N 0) (ADR 0)) 
(DO () (()) (PHYS-MEM-WR1TE ADR N))) 

(defun p-mn-mem-r-lQop (^optional (adr 0)) 
( d0 () (()) (phys-mem-read adr))) 

(DEFUN P-MN-MEM-RWC-LOOP (&OPTI0NAL (ADR 0) (DATA1 0) (DATA2 37777777777)) 
(DO () (()) 

(P-MN-MEM-RWC ADR DATA1) 
(P-MN-MEM-RWC ADR DATA2))) 

(DEFUN P-MN-MEM-RWC (ADR DATA &AUX READ-BACK) 
(PHYS-MEM-WRITE ADR DATA) 
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(COND ((NOT (■ DATA (SETQ READ-BACK (PHYS-MEM-READ ADR)))) 
(FORMAT T "~%Addr: ~0 Wrote: -110 Read: -110" 
ADR DATA READ-BACK)))) 

(DEFUN P-MN-MEM-RW-LOOP (&0PTI0NAL (ADR 0) (DATA1 0) (DATA2 37777777777)) 
(DO () (()) 

(PHYS-MEM-WRITE ADR DATA1) 
(PHYS-MEM-READ ADR) 
(PHYS-MEM-WRITE ADR DATA2) 
(PHYS-MEM-READ ADR))) 

(DEFUN P-L1-MAP-L0OP (&OPTIONAL (ADR 0) (DATA 0)) 
(DO () (()) 

(CC-WRITE-LEVEL-1-MAP ADR DATA))) 

(DEFUN P-TEST-MICRO-STACK-PTR NIL 

(DO ((COUNT 32. (1- COUNT))) ;UNTIL USP EQUALS THE DESIRED VALUE, 

((< COUNT 0)) 

(PRINT (CC-READ-MICRO-STACK-PTR)) 
(CC-EXECUTE (WRITE) CONS-IR;M-SRC CONS-M-SRC-MICRO-STACK-POP) ) ) ;KEEP POPPING IT 

(DEFUN P-MICRO-STACK-READ-TEST NIL 
(DO () 

(0) 

(CC-READ-MICRO-STACK-PTR))) 

(DEFUN P-UNIBUS-W-LOOP (ADR &OPTIONAL (DATA 0)) 
(DO () 

(()) 
(DB6-WRITE ADR DATA))) 



Functions for debugging disk controllers 



Part 6 - Write and read block 1 of the disk. Use a floating l's and 0*s 

pattern, and then an address pattern, and check for Xbus data path 
and addressing failures. 
This doesn't check high-order address bits 
(DEFUN DLOOP () 
(DO () (()) 
(DO I (1+ I) (- I 40) ;Loc 0-37 get floating l's 

(PHYS-MEM-WRITE I (#M LSH #Q ASH 1 I))) 
(DO I (1+ I) (- I 40) ;Loc 40-77 get floating O's 

(PHYS-MEM-WRITE (+' 40 I) (- (#M LSH #Q ASH 1 32.) (#M LSH #Q ASH 1 I)))) 
(DO I 100 (1+ I) (■ I 400) ;Loc 100-377 get address pattern 
(PHYS-MEM-WRITE I (+ (LSH (LOGXOR 377 I) 8) I))) 
; (PRINT 'WRITE) 
(DC-EXEC DC-WRITE 1 CCW-LOC DC-ALL-ERROR-BITS) 
; (LET ((MA (DC-READ-MA))) 
; #M (DECLARE (FIXNUM MA)) 
; (COND ((NOT (- MA 377)) 

; (TERPRI) (PRINC ' |MA wrong on write of pattern, correct«*377, actua1*|) 
; (PRIN1 MA)))) 

(DO I (1+ I) (- I 400) ;Clear buffer 
(PHYS-MEM-WRITE 10)) 
; (PRINT 'READ) 
(DC-EXEC DC-READ 1 CCW-LOC DC-ALL-ERROR-BITS) 
(LET ((MA (DC-READ-MA))) 
#M (DECLARE (FIXNUM MA)) 
(COND ((NOT (- MA 377)) 

(TERPRI) (PRINC ' |MA wrong on read of pattern, correct*377, actual*!) 
(PRIN1 MA) (TERPRI)))) 
; ; Check pattern read back into core, see if it's correct 
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(LET ((DCHECK-AND 37777777777) (DCHECK-IOR 0) {Accumulate error bits here 
(DCHECK-ADR-AND 377) (DCHECK-ADR-IOR 0)) 
(DO I (1+ I) (- I 40) ;Loc 0-37 get floating i's 

(DCHECK-CQMPARE I (#M LSH #Q ASH II))) 
(DO I (1+ I) (■ I 40) ;Loc 40-77 get floating O's 

(DCHECK-COMPARE (+ 40 I) (- (#M LSH #Q ASH 1 32.) (#M LSH #Q ASH 1 I)))) 
(DO I 100 (1+ I) (■ I 400) ;Loc 100-377 get address pattern 

(DCHECK-COMPARE I (+ (#M LSH #Q ASH (LOGXOR 377 I) 8) I))) 
(DCHECK-PM '|Data bits dropped during write to or read from disk: | 

(LOGXOR 37777777777 DCHECK-IOR)) 
(DCHECK-PM '[Data bits picked during write to or read from disk: | 

DCHECK-AND) 
(DCHECK-PM '|Address bits with bad data during write to or read from disk: | 

(LOGXOR 377 DCHECK-ADR-AND)) 
(DCHECK-PM '|Address bits 1 with bad data during write to or read from disk: | 
DCHECK-ADR-IOR)) 
));; Maybe there should be a test-loop for the above? 
A C-C"C 
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; ; ; -*-Mode:LISP;Package:CC;Basa:8. ;Fonts:CPTFONT-»- 
; ; ; Cadr cliagnositics 

(DEFUN ROT32 (NUM AMT) 
(LOGAND 37777777777 

(COND ((< AMT 30) (+ (ASH NUM AMT) ( LDB (+ (LSH (~ 40 AMT) 6) AMT) NUM))) 
(T (DPB (LDB (- 40 AMT) NUM) 

(+ (LSH AMT 6) (- 40 AMT)) 
(ASH NUM (- AMT 40))))))) 

(DEFMACRO ONES-COMPLEMENT (X) ;Can't use LOGXOR with -1 on bignums! 
'(BOOLE 14 ,X)) 
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;;; Function for scoping. Stop when a key hit. Only forms which evaluate their 
;;; arguments allowed here. 

(DEFUN CC-LOOP (FORM) 
(DO ((FCN (CAR FORM)) 

(ARGS (MAPCAR #*EVAL (CDR FORM)))) 
((KBD-TYI-NO-HANG)) 
(APPLY FCN ARGS))) 

(DECLARE (SPECIAL CC-LOW-LEVEL-FLAG CC-DIAG-TRACE) ) 
(DEFVAR ALL-DATA-PATHS 

'(CC-TEST-IR-DP CC-TEST-PC-DP CC-TEST-MD-DP CC-TEST-VMA-DP 
CC-TEST-M-MEM-DP CC-TEST-A-MEM-DP 

■CC-TEST-PP-DP CC-TEST-PI-DP CC-TEST-PDL-DP CC-TEST-Q-DP CC-TE'ST-C-MEM-DP 
CC-TEST-LC-DP CC-TEST-A-PASS-DP CC-TEST-M-PASS-DP 
CC-TEST-ALU-SHIFT-LEFT-DP CC-TEST-ALU-SHIFT-RIGHT-DP 
CC-TEST-UNIBUS-MAP-DP CC-TEST-BUSINT-BUFFERS-DP)) 
(DEFVAR ALL-MEMORIES 

'( (M-MEM .RAMMG 32. 5.) 

(A-MEM ,-RAAMO 32. 10.) , 
(PDL-BUFFER , RAPBO 32. 10.) 
(C-MEM .RACMO 48. 14.) 
(D-MEM .RADMO 16. 11.) 
;NOTE, CAN'T TEST BIT 16 OF D-MEM (R-BIT) 
(SPC .RAUSO 19. 5.) 
(LEVEL-1-MAP .RAM10 5. 11.) 
(LEVEL-2-MAP , RAM20 24, 10.) 
(UNIBUS-MAP .RAUBMO 16. 4) )) 

(def macro deftest (function-name defun-args test-name &body forma) 
'(progn 'compile 

(putprop ' .function-name .test-name 'test-name) 
(defun .function-name , defun-args , ©forms))) 

(DEFMACRO RUN-TEST-FUNCTION (FUNCTION-NAME &REST ARGS) 
'(PROGN 'COMPILE 

(format t "~2&Running -A test~%" (get '.function-name 'test-name)) 
(.FUNCTION-NAME ,®ARGS))) 

;;; Toplevel machine checking 

(DEFUN CC-TEST-MACHINE (^OPTIONAL (C~MEM-BANKS~TO-TE$T 3)) 
(LET ((CC-LOW-LEVEL-FLAG 'VERY)) 

(IF (AND (EQ DBG-ACCE5S-PATH 'SERIAL) 
(BOUNDP 'SERIAL-STREAM)) 
(FUNCALL SERIAL-STREAM ' :CLEAR-INPUT) ) 

(FORMAT T "~&For best results, ground -TPTSE, 1C07-09 on CMEM boards. 
Resetting machine") 

(DBG-RESET) {Forcibly reset the whole machine 

(CC-RESET-MACH) :NOW SET TO THE CORRECT MODE 

(RUN-TEST-FUNCTION CC-TEST-DATA-PATHS ALL-DATA-PATHS) 

(RUN-TEST-FUNCTION CC-FAST-ADDRESS-TESTS ALL-MEMORIES) 

( RUN-TEST-FUNCTION CC-FAST-ADDRE5S-TEST-C-MEM-BANKS C-MEM-BANKS-TO-TEST) 

(RUN-TEST-FUNCTION CC-TEST-SPC-PO-INTER) 

(RUN-TEST-FUNCTION CC-TEST-SHIFTER-LOGIC) 

(RUN-TFST- FUNCTION CC-TEST-OA-REGS) 

(RUN -TEST-FUNCTION CC-TEST-D1SPATCH) 

(RUN-TEST-FUNCTION CC-TEST-CLOCK) 

NIL)) 

(DEFTEST CC-TEST-SHIFTER-LOGIC () "Shifter logic" 
(CC-TEST-MASK-LEFT) 
(CC-TEST- MASK-RIGHT) 
(CC-TEST-MASKER) 
(CC-TEST-SHIFTER) 
(CC-TEST-LC-AFFECTS-SHIFT)) 

(DEFTEST CC-TEST-DATA-PATHS (DATA-PATH-LIST) "Data paths" 
(MAPC #' (LAMBDA (FUNCTION) 
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(FORMAT T H ~&~4T[Runn1ng ~A.]~% M FUNCTION) 
(APPLY FUNCTION NIL)) 
DATA-PATH-LIST)) 

(DEFtest CC-FA5T-ADDRESS-TESTS (MEMORIES-LIST) "Fast address" 
(MAPC ft' (LAMBDA (X) 

(FORMAT T "~&~4T[Fa'$t address tost ~A]~%" (CAR X)) 
(APPLY 'CC-FAST-ADDRESS-TEST X)) 
MEMORIES-LIST)) 

(DEFtest CC -GROSS-DATA-TESTS (MEMORIES-LIST) "Gross data" 
(LET ((CC-LOW-LEVEL-FLAG 'VERY)) 

(FORMAT T "Resetting machine . . .") 

(DBG-RESET) {Forcibly reset the whole machine 

(CC-RESET-MACH) ; Now set to the correct mode 

(SEND TERMINAL-10 ' : TYO ACR) 

(MAPC r (LAMBDA (X) 

(FORMAT T "~&~4TGross data test ~A~%" (CAR X)) 
(APPLY 'CC-6R0SS-DATA-TEST X)) 
MEMORIES-LIST))) 

(DEFUN CC-OTHER-TESTS NIL 

(RUN-TEST-FUNCTION CC-TEST-PC-INCREMENTER) 

(RUN-TEST-FUNCTION CC-TEST-SPY-IR) 

(RUN-TEST-FUNCTION CC-TEST-INCREMENTER) 

(RUN-TEST-FUNCTION CC-TES1 -ARITH-COND-JUMP) 

(RUN-TEST-FUNCTION CC-GROSS-OATA-TESTS ALL-MEMORIES) 

( RUN-TEST-FUNCTION CC-ADDRESS-TEST-A-MEM) 

(RUN-TEST-FUNCTION CC-TEST-M-MEM-ADR) 

(RUN-TEST-FUNCTION CC-TEST-A-MEM-ADR) 

(RUN-TEST-FUNCTION CC-TEST-PDL-ADR)) 

;Test each 4K separately since they have separate address drivers 

(DEFtest CC-FAST-ADDRESS-TEST-C-MEM-BANKS (&OPTIONAL (NBANKS 4)) "C-MEM Banks Fast Address" 
(DOTIMES (BANK NBANKS) 

(CC-FAST.-ADDRESS-TEST 1 

(FORMAT NIL "CMEM-BANK ~A" BANK) (+ RACMO (* BANK 10000)) 48. 12.))) 



p$:<akr>d1ags.txt>l 1 October i9BZ OQtlZiAZ Page 4 



;;; Topleve'l data path tests 

(DEFUN CC-TEST-IR-DP () 

(CC-TEST-DATA-PATH "Unibus A Y DE-BUG-IR A Y IR A Y SPY1 A Y Unibus" RAIR 48.)) 

(DEFUN CC-TEST-PC-DP- () 

(CC-TEST-DATA-PATH "Unibus A Y DEBUG-IR A Y IR(Jump) A Y PC A Y SPY2 A Y Unibus" RAPC 14.)) 

(DEFUN CC-TEST-MD-DP () 

(CC-TEST-DATA-PATH "Unibus A Y Xbus (MEM bus on 1A-J1 and 1B-J1) A Y MDS A Y MD A Y MF A Y (m) 
"Y ALU A Y Obus (MOO and MOl prints) A Y SPY1 A Y Unibus" RAMD 32.)) 

(DEFUN CC-TEST-VMA-DP () 

(CC-TEST-DATA-PATH "(Unibus A Y Xbus (MEM bus on 1A-J1 and 1B-J1) A Y MDS A Y MD 

'■Y MF A Y (m) A Y ALU A Y Obus A Y VMAS A Y VMA "Y MF A Y (in) 

"Y ALU A Y Obus (MOO and MOl prints) A Y Unibus" RAVMA 
32.)) 

(DEFUN CC-TEST-M-MEM-DP () 

(CC-TEST-DATA-PATH "Unibus A Y Xbus (MEM bus on 1A-J1 and 1B-J1) A Y MDS A Y MD A Y MF A Y (m) 
"Y ALU *Y Obus (MOO and MOl prints) A Y L A Y M-MEM «Y MLATCH A Y (m) A Y ALU A Y Obus A Y SPY1 A Y 
Unibus" 
RAMMO 32.)) 

(DEFtest CC~TEST<-M~MEM (&OPTIGNAL (VI 0) (VZ -1) (ADR 1)) "M-MEM" 
(until-key 

(CC-WRITE-M-MEM ADR VI) 
(CC-READ-M-MEM ADR) 
(CC-WRITE-M-MEM ADR V2) 
(CC-READ-M-MEM ADR))) 

(DEFUN CC-TEST-A-MEM-DP () 

(CC-TEST-DATA-PATH "Unibus A Y Xbus (MEM bus on 1A-J1 and 1B-J1) ~Y MDS A Y MD A Y MF ~Y (m) 
"Y ALU A Y Obus (MOO and MOl prints) A Y L A Y A-MEM A Y ALATCH A Y (a) A Y ALU A Y Obus A Y SPY1 ~Y 
Unibus" 
RAAMO 32.)) 

(DEFtest CC-TEST-A-MEM (&OPTIQNAL (VI 0) (V2 -1) (ADR 1)) "A-MEM" 
(until-key 

(CC-WRITE-A-MKM ADR VI) 
(CC-READ-A-MEM ADR) - 
(CC-WRITE-A-MEM ADR V2) 
(CC-READ-A-MEM ADR))) 

(DEFtest CC-TEST-A-MEM-ADDRESSES NIL "A-MEM Addresses" 
(WITHOUT-INTERRUPTS 

(DO ((ADR 1 (LSH ADR 1))) 
((KBD-TYI-NO-HANG)) 
(IF (> ADR 1000) (SETQ ADR 1)) 
(CC-WRITE-A-MEM ADR 0) 
(CC-WRITE-A-MEM ADR -1)))) 

(DEFUN CC-TEST-PP-DP () 

(CC-TEST-DATA-PATH "Unibus A Y Xbus (MEM bus on 1A-J1 and 1B-J1) ^Y MDS A Y MD A Y MF A Y (m) 
"Y ALU *Y Obus (MOO and MOl prints) A Y PP A Y MF *Y (m) A Y ALU A Y Obus A Y SPY1 A Y Unibus" 
RAPP 10.)) 

(DEFUN CC-TEST-PI-DP () 

(CC-TEST-DATA-PATH "Unibus A Y Xbus (MEM bus on ' 1A-J1 and 1B-J1) A Y MDS A Y MD -Y MF "Y (m) 
"Y ALU *Y Obus (MOO and MOl prints) A Y PI A Y MF *Y (m) A Y ALU ~Y Obus *Y Unibus" 
RAPI 10.)) 

(DEFUN CC-TEST-PDL-DP () 

(CC-TEST-DATA-PATH "Unibus A Y Xbus (MEM bus on 1A-J1 and 1B-J1) A Y MDS 'Y MD -Y MF -Y (m) 
"Y ALU ~Y Obus (MOO and MOl prints) A Y L "Y PDL-Buffer A Y PLATCH A Y (m) *Y ALU A Y Obus A Y 
Unibus" 

RAP80 32,)) 
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(DEFtest CC-TEST-PDL-ADDRESSES () "PDL Addresses" 
(DO ((BIT 1 (IF (> BIT 1000) 1 (LSI) BIT 1)))) 
((KBD-TYI-NO-HANG)) 
(CC-R-D (+ RAPBO BIT) 0))) 

(DEFUN'CC-TEST-Q-DP () 

(CC-TEST-DATA-PATH "Unibus A Y Xbus (MEM bus on 1A-J1 and 1B-J1) A Y MDS A Y MD A Y ALU A Y 
Q A Y MF A Y (m) A Y ALU A Y Obus A Y Unibus" 
RAQ 32.)) 

(DEFUN CC~TEST~C-MEM~DP () 

(CC-TEST-DATA-PATH 
"•FIRST* Unibus A Y Xbus (MEM bus on 1A-01 and 1B-J1) A Y MDS A Y MD A Y MF A Y (m) 

A Y ALU A Y Obus (MOO and MOl prints) A Y L A Y M-MEM 
*THEN* Unibus A Y Xbus (MEM bus on 1A-J1 and 1B-J1) *Y MDS A Y MD A Y MF A Y (m) 

A Y ALU A Y Obus (MOO and MOl prints) A Y L A Y A-MEM 
*AND FINALLY* A-MEM & M-MEM A Y IWR A Y C-MEM A Y IR(Jump) A Y Unibus" RACMO 48.)) 

(DEFtest CC-TEST-C-MEM (^OPTIONAL (VI 0) (V2 -1) (ADR 0)) "C-MEM" 
(UNTIL-KEY 

(CC-WRITE-C-MEM ADR VI) 
(CC-WRITE-C-MEM ADR V2))) 

(DEFUN CC-TEST-LC-DP () 

(CC-WRITE-FUNC-DEST CONS-FUNC-DEST-INT-CNTRL 1_29.) ;SET LC BYTE MODE 
(CC-TEST-DATA-PATH "Unibus A Y Xbus A Y MD A Y MF A Y (m) 
A Y ALU A Y Obus (MOO and MOl prints) A Y LC A Y MF A Y M A Y ALU A Y Obus" RALC 26.)) 

(DEFUN CC-TEST-A-PASS-DP () 

(CC-TEST-DATA-PATH " A Y L A Y APASS A Y A A Y ALU" ' (CC-A-PASS-HANDLER) 32.)) 

(DEFUN CC-TEST-M-PASS-DP () 

(CC-TEST-DATA-PATH " A Y L A Y MPASS A Y MF A Y M A Y ALU" ' (CC-M-PASS-HANDLER) 32.)) 

(DEFUN CC-TEST-ALU-SHIFT-LEFT-DP () 

(CC-TEST-DATA-PATH "MD,Q(31) A Y ALU-SHIFT-LEFT-1" ' (CC-ALU-SHIFT-LEFT-HANDLER) 32.)) 

(DEFUN CC-TEST-ALU-SHIFT-RIGHT-DP () 

(CC-TEST-DATA-PATH "MD A Y M+M A Y ALU-SHIFT-RIGHT-1" ' (CC-ALU-SHIFT-RIGHT-HANDLER) 32.)) 

(DEFUN CC-TEST-UNIBUS-MAP-DP () 

(CC-TEST-DATA-PATH "Unibus Map" RAUBMQ 16.)) 

;Read and write Xbus location through all 16 Unibus buffers 
(DEI UN CC-TEST-BUSINT-BUFFERS-DP () 
(COND ((EQ SPY-ACCESS-PATH 'BUSINT) 

(DO DBG-UNIBUS-MAP-NUMBER (1+ DBG-UNIBUS-MAP-NUMBER) (- DBG-UNIBUS-MAP-NUMBER 20) 
(CC-TEST-DATA-PATH 

(FORMAT NIL "Unibus A Y Buffer -0 A Y Xbus loc A Y Buffer -0 A Y Unibus" 

DBG-UNIBUS-MAP-NUMBER DBG-UNJBUS-MAP-NUMBER) 
200000 32.))))) 
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(DEFUN CC~A-PA5S~HANDLER (OP DATA) 
(SELECTQ OP 
(WRITE-READ 
(CC-WRITE-MD DATA) ; PUT VALUE INTO THE MRP REGISTER 
(CC-EXECUTE {NOTE NO WRITE, JUST PUT IT IN IR 

CONS-IR-M-SRC CONS-M-SRC-MD ;MOVE IT TO DESIRED PLACE 
CONS-IR-ALUF CONS-ALU-SETM 
CONS-IR-OB CONS-OB-ALU 

CONS-IR-A-MEM-DEST (+ CONS-A-MEM-DEST-INDICATOR 0)) 
(CC-EXECUTE (EXECUTOR CC-EXECUTE-LOAD-DEBUG-IR) 

CONS-IR-A-SRC ; PUT IT ONTO THE OBUS 

CONS-IR-ALUF CONS-ALU-SETA 
CONS-IR-OB CONS-OB-ALU) 
(CC-DEBUG-CLOCK) ; EXECUTE THE WRITE. LOAD IR WITH THE READ 

(LET ((ACTUAL (CC-READ-OBUS) ) ) ;READ BACK THE DATA VIA THE PASS AROUND PATH 
(COND ((AND CC-DIAG-TRACE (NOT (- ACTUAL DATA))) 

(FORMAT T "~%A-PASS WROTE ~0 READ ~0" DATA ACTUAL))) 
ACTUAL)) 
(OTHERWISE (FERROR NIL "Unknown A-Pass Handler Operation")))) 

(DEFUN CC-M-PASS-HANDLER (OP DATA) 
(SELECTQ OP 
(WRITE-READ 

(CC-WRITE-MD DATA) ;PUT VALUE INTO THE MRD REGISTER 

(CC-EXECUTE ;NOTE NO WRITE, JUST PUT IT IN IR 
CONS-IR-M-SRC CONS-M-SRC-MD 
CONS-IR-ALUF CONS-ALU-SETM 
CONS-IR-OB CONS-OB-ALU 
CONS-IR-M-MEM-DEST 0) ;ADR 

(CC-EXECUTE (EXECUTOR CC~EXECUTE~LOAD~DEBUG-IR) 

CONS-IR-M-SRC ; PUT IT ONTO THE OBUS 
CONS-IR-ALUF CONS-ALU-SETM 
CONS-IR-OB CONS-OB-ALU) 
(CC-DEBUG-CLOCK) ; EXECUTE THE WRITE, LOAD IR WITH THE READ 

(LET ((ACTUAL (CC-READ-OBUS))) .-.READ BACK THE DATA VIA THE PASS AROUND PATH 
(COND ((AND CC-DIAG-TRACE (NOT (- ACTUAL DATA))) 

(FORMAT T "~%M-PASS WROTE ~0 READ -0" DATA ACTUAL))) 
ACTUAL)) ' 
(OTHERWISE (FERROR NIL "UNKNOWN OP")))) 

(DEFUN CC-ALU-SHIFT-LEFT-HANDLER (OP DATA) 
(SELECTQ OP 
(WRITE-READ 
(CC-WRITE-Q (ASH (LOGAND DATA 1) 31.)) ilow bit to high bit of Q 
(CC-WRITE-MD (ASH DATA -1)) 

(CC-EXECUTE {NOTE NO WRITE, JUST PUT IT IN IR 

CONS-IR-M-SRC CONS-M-SRC-MD 
CONS-IR-ALUF CONS-ALU-SETM 
CONS-IR-OB CONS-OB-ALU-LEFT-1) 
(LET ((ACTUAL (CC-READ-OBUS))) 

(COND ((AND CC-DIAG-TRACE (NOT (- ACTUAL DATA))) 

(FORMAT T "~%ALU-LEFT WROTE -0 READ -0" DATA ACTUAL))) 
ACTUAL)) 
(OTHERWISE (FERROR NIL "UNKNOWN OP")))) 

(DEFUN CC-ALU-SHIFT-RIGHT-HANDLER (OP DATA) 
(SELECTQ OP 
(WRITE-READ 
(CC-WRITE-MD DATA) 
(CC-EXECUTE 

CONS-IR-M-SRC CONS-M-SRC-MD 
CONS-IR-ALUF CONS-ALU-M+M 
CONS-IR-OB CONS-OB-ALU-RJGHT-1) 
(LET ((ACTUAL (CC-READ-OBUS))) 

(COND ((AND CC-DIAG-TRACE (NOT (- ACTUAL DATA))) 

(FORMAT T "~%ALU-RIGHT WROTE ~0 READ ~0" DATA ACTUAL))) 
ACTUAL)) 
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(OTHERWISE (FERROR NIL "UNKNOWN OP")))) 

;;; Numeric list operations 

(DEFMACRO NUMERIC-LIST-OELQ (N L) 
'(SETQ ,L (DELQ ,N t L))) 

(DEFUN NUMERIC-LIST-MEMQ (N L) 
(DO ((L L (CDR L))) 
((NULL L) NIL) 
(AND (* (CAR L) N) 
(RETURN L)))) 

(DEFUN NUMERIC-LIST-UNION (LI L2) 
(DO ((L LI (CDR L)) 
(R L2)) 
((NULL L) R) 
(OR (NUMERIC-LIST-MEMQ (CAR L) R) 
(SETQ R (CONS (CAR L) R))))) 

(DEFUN NUMERIC-LIST-INTERSECTION (LI L2) 
(DO ((L LI (CDR L)) 
(R NIL)) 
((NULL L) R) 
(AND (NUMERIC-LIST-MEMQ (CAR L) L2) 
(SETQ R (CONS (CAR L) R))))) 

(DEFUN NUMERIC-LIST-DIFFERENCE (LI L2) 
(DO ((L LI (CDR L)) 
(R NIL)) 
((NULL L) R) 
(OR (NUMERIC-LIST-MEMQ (CAR L) L2) 
(SETQ R (CONS (CAR L) R))))) 
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; ; ; Data path internals 

(DEFUN CC-WRITE-AND-READ (REGADR DATA &OPTIONAL (MASK. 37777777777)) 
(COND ((ATOM REGADR) 

(CC-R-D REGADR DATA) 

(LET ((ACTUAL (CC-R-E REGADR))) 

(COND ((AND CC-DIAG-TRACE (NOT (ZEROP (LOGAND (LOGXOR ACTUAL DATA) MASK)))) 

(FORMAT T "~&Reg address ~0, wrote -0, read ~Q" REGADR DATA ACTUAL))) 
ACTUAL)) 
(T (FUNCALL (CAR REGADR) 'WRITE-READ DATA)))) 

(DEFVAR CC-SUSPECT-BIT-LIST) ; Must be bound around CC-PRINT-BIT-LIST 

; RETURNS T IF IT WORKS, PRINTS MESSAGE AND RETURNS NIL IF IT IS BUSTED. 
(DEFUN CC-TEST-DATA-PATH (MESSAGE REGADR NBITS) 
(LET ((CC-LOW-LEVEL-FLAG 'VERY) 
(TEM) 

(CC-SUSPECT-BIT-LIST NIL) 
(ZEROS 0) 

(ONES (SUB1 (LOGDPB 1 (+ (,LSH NBITS 6) 0001) 0)))) 
(COND ((■ (SETQ TEM (CC-WRITE-AND-READ REGADR ZEROS ONES)) 
(CC-WRITE-AND-READ REGADR ONES ONES)) 
(CC-BARF-ABOUT-DATA-PATH MESSAGE REGADR) 

(FORMAT T "~&~4TCan't affect 1t, erroneous value is ~0~%" TEM) 
NIL) 
(T (LET ((BITS-NOT-ONE (CC-TEST-DATA-PATH-FLOATING-BITS REGADR NBITS ZEROS)) 
(BITS-NOT-ZERO (CC-TEST-DATA-PATH-FLOATING-BITS REGADR NBITS ONES))) 
(COND ((AND (NULL BITS-NOT-ONE) (NULL BITS-NOT-ZERO) ;NO ERROR 
(NULL CC-SUSPECT-BIT-LIST)) 
T) 
(T 
(LET ((ERRONEOUS-BITS ;BITS THAT LOSE, TEST FOR SHORTING 
(NUMERIC-LIST-UNION BITS-NOT-ONE BITS-NOT-ZERO))) 
(LET ((STUCK-AT-ZERO 

(NUMERIC-LIST-DIFFERENCE BITS-NOT-ONE BITS-NOT-ZERO)) 
(STUCK-AT-ONE 

(NUMERIC-LIST-DIFFERENCE BITS-NOT-ZERO BITS-NOT-ONE))) 
(CC~BARF-ABOUT-DATA-PATH MESSAGE REGADR) 
(CC-PRINT-BIT-LIST "Bits stuck at zero: " STUCK-AT-ZERO) 
(CC-PRINT-BIT-LIST "Bits stuck at one: " STUCK-AT-ONE) 
(AND (■ (LENGTH ERRONEOUS-BITS) 2) ;MAYBE THEY'RE SHORTED TOGETHER 
(CC-TEST-DATA-PATH-SHORTED-BIT REGADR NBITS 

(CAR ERRONEOUS-BITS))) 
NIL) 
(CC-PRINT-BIT-LIST "The following bits are also suspected of being losers:" 
CC-SUSPECT-BIT-LIST) 

)))))))) 

; RETURN LIST OF BIT NUMBERS WHICH WON'T SET DIFFERENT FROM THE OTHERS. 
;ALSO SETS CC-SUSPECT-BIT-LIST TO BITS WHICH ARE NOTICED TO 
;BE LOSING WHILE TESTING DIFFERENT BITS. 
;NOTE THE NEED TO DO BIGNUM ARITHMETIC. 

(DEFUN CC-TEST-DATA-PATH-FLOATING-BITS (REGADR NBITS BACKGROUND) 
! FIRST, DETERMINE SENSE OF BIT LOOKING FOR 
(LET ((BACK-BIT (COND ((ZEROP BACKGROUND) 0) (T 1))) 
(SET-BIT (COND ((ZEROP BACKGROUND) 1) (T 0))) 
(MASK (1- (LOGDPB 1 (+ (LSH NBITS 6) 0001) 0)))) 
(DO ((BITNO (1+ BITNO)) 

(BITPOS 0001 (+ BITPOS 0100)) 
(READBACK) 
(ERROR-LIST NIL)) 
((>- BITNO NBITS) ERROR-LIST) 
(SETQ READBACK (CC-WRITE-AND-READ REGADR (LOGDPB SET-BIT BITPOS BACKGROUND) MASK)) 
(DO ((I (1+ I)) 

'(PPSS 0001 (+ PPSS 0100)) 
(BIT)) 
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((>■ I NBITS)) 
(SETQ BIT (LOGLDB PPSS READBACK)) 
(COND ((- I BITNO) 

(OR (■ SET-BIT BIT) 

(PUSH I ERROR-LIST))) 
(T (OR (- BACK-BIT BIT) 

(CC-FINGER-SUSPECT-BIT I)))))))) 

(DEFUN CC-FINGER-SUSPECT-BIT (BITNO) 

(OR (NUMERIC-LIST-MEMQ BITNO CC-SUSPECT-BIT-LIST) 

(SETQ CC-SUSPECT-BIT-LIST (CONS BITNO CC-SUSPECT-BIT-LIST)))) 

;GIVEN A BIT WHICH FAILS, TRY TO PROVE IT IS SHORTED TO SOME OTHER BIT. 
; PRINT OUT THE RESULTS AND OUGHT TO REMOVE FROM SUSPECT LIST. ******* 

;NOTE THAT FOR NON-COMPLEMENTED TRI-STATE DATA PATHS, 1 SHORTED TO GIVES 0, 
;THUS IN THE NORMAL TEST SHORTED BITS LOOK STUCK AT ZERO. 
;THIS ONLY TESTS WITH ONES. 

(DEFUN CC-TEST-DATA-PATH-SMORTED-BIT (REGADR NBITS BITNO) 
(DO ((BAD-BIT (LOGDPB 1 (+ (LSH BITNO 6) 0001) 0)) 
(I (1+ I)) 

(TEST-BIT 0001 (+ TEST-BIT 100)) . 
(BASE 10.) 
(*NOPOINT T) 
(LOSING-BITS NIL)) 
((>" I NBITS) 
(COND ((* (LENGTH LOSING-BITS) 1) 

(NUMERIC-LIST-DELQ (CAR LOSING-BITS) CC-SUSPECT-BIT-LIST) 

(FORMAT T "~&~4TB1t ~D is shorted to bit ~D~%" BITNO (CAR LOSING-BITS))) 

(T 
(FORMAT T "~&~4TBit ~D has problems, can't isolate. «%" BITNO) 
(CC-PIUNT-BIT-LIST "Seems as if shorted to bits " LOSING-BITS)))) 
(LET ((BOTH-BITS (LOGDPB 1 TEST-BIT BAD-BIT))) 

(COND ((■ I BITNO)) ;OF COURSE IT'S SHORTED TO ITSELF1 

((" BOTH-BITS (CC-WRITE-AND-READ REGADR BOTH-BITS)) 
(PUSH I LOSING-BITS)))))) 

(DEFUN CC-BARF-ABOUT-DATA-PATH (MESSAGE. REGADR) 

(FORMAT T "~%~4TTesting register addresses ~0,~%~6TData path is ~A." REGADR MESSAGE)) 

(DEFUN CC-PRINT-BT.T3 (WD) 

(LET ((CC-SUSPECT-BIT-LIST NIL)) -.KLUDGE 

(CC-PRINT-BIT-LIST NIL (CC-WRONG-BITS-LIST WD (HAUL0N6 WD))))) 

(DEFUN CC-PRINT-BIT-LIST (MESSAGE BITLIST) 
(COND (BITLIST 

(IF MESSAGE (SEND TERMINAL-IO ':STRING~OUT MESSAGE)) 
(DO ((L (SORT BITLIST #'LESSP) (CDR L)) 
(COMMA NIL T) 
(LASTVALUE -Z (CAR L)) 
(RANGE-END NIL) 
(RANGE-START)) 
((NULL L) 
(AND RANGE-END 

(IF (- (1+ RANGE-START) RANGE-END) 

(FORMAT T ", ~D" RANGE-END)) 
(FORMAT T "~~D" RANGE-END))) 
(COND ((* (CAR L) (1+ LASTVALUE)) 

(OR RANGE-END (SETQ RANGE-START LASTVALUE)) 
(SETQ RANGE-END (CAR L))) 
(T 
(AND RANGE-END 

(IF (■ (1+ RANGE-START) RANGE-END) 
(FORMAT T ", ~D" RANGE-END) 
(FORMAT T "~~D" RANGE-END))) 
(SETQ RANGE-END NIL) 

(AND COMMA (SEND TERMINAL-IO ' :STRING~OUT ", *')) 
( FORMAT :ONUM (CAR L))))) 
(SETQ CC-SUSPECT-BIT-LIST 

(NUMERIC-LIST-DIFFERENCE CC-SUSPECT-BIT-LIST BITLIST)) 
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(SEND TERMINAL-IO ' :TYQ ACR)))) 

;;; CADR ADDRESS TESTS THAT RUN IN THE MACHINE 

(DECLARE (SPECIAL CC-MQDE-REG CC-DIAG-TRACE) ) 

(COMMENT TEST LOOP STORERS) 

WRITE A-MEMORY, LC HAS ADDRESS SHIFTED INTO DESTINATION FIELD, 

VMA IS ADDED TO LC EACH TIME AROUND THE LOOP, STOP VIA THE STATISTICS COUNTER, 

MD HAS VALUE TO BE STORED, Q-R GETS ADDED TO MD EACH TIME AROUND THE LOOP. 

TO DO THE ADDITIONS WE NEED SOMETHING IN A-MEM. WE CAUSE IT TO COME 

IN FROM THE PASS-AROUND PATH SO AS NOT TO TRUST THE MEMORY! 

((OA-REG-LOW) LC) 

((A-MEM) MD STAT-BIT) ;HALT HERE WHEN DONE 



((17770A) Q-R) 
((MD) ADD MD 17770A) 
((17770A) VMA) 
((LC) ADD LC 17770A) 
(JUMP 0) 



THIS VERSION FILLS IT ALL ALTHOUGH IT COULD HAVE MORE PARAMETERS 
BASHES 0©M AS USUAL 

WRONG VALUE IN 0@A BECAUSE THE CODE BASHES 0@M AS IT RUNS AND A*M 
(DEFUN CC-FILL-A-MEM (VALUE VALUE-INC UPWARDS-P) 
(CC-EXECUTE (W-C-MEM 0) 

CONS-IR-M-SRC CONS-M-SRC-LC 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-SETM 

CONS-IR-FUNC-DEST CONS-FUNC-DEST-OA-LOW) 
(CC-EXECUTE (W-C-MEM 1) 

CONS-IR-STAT-BIT 1 

CONS-IR~M-SRC CONS-M-SRC-MD 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-SETM 

CONS-IR-A-MEM-DEST CONS-A-MEM-DEST-INDICATOR) 
(CC-EXECUTE (W-C-MEM 2) 

CONS-IR-M-SRC CONS-M-SRC-Q 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-SETM 

CONS-IR-A-MEM-DEST CONS-A-MEM-DEST-1777) 
(CC-EXECUTE (W-C-MEM 3') 

CONS-IR-M-SRC CONS-M-SRC-MD 

CONS-IR-A-SRC 1777 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-ADD 

CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD) 
(CC-EXECUTE (W-C-MEM 4) 

CONS-IR-M-SRC CONS-M-SRC-VMA 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-SETM 

CONS-IR-A-MEM-OEST CONS-A-MEM-DEST-1777) 
(CC-EXECUTE (W-C-MEM 5) 

CONS-IR-M-SRC CONS-M-SRC-LC 

CONS-IR-A-SRC 1777 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-ADD 

CONS-IR-FUNC-DEST CONS-FUNC-DEST-LC) 
(CC-EXECUTE (W-C-MEM 6) 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-JUMP-ADDR 

CONS-IR-JUMP-COND CONS-JUMP-COND-UNC 

CONS-IR-N 1) 
(CC-EXECUTE (W-C-MEM 7) ;SO HAS GOOD PARITY 

CONS-IR-OP CONS-OP-JUMP) 
(CC-WRITE-STAT-COUNTER -1024.) ;STOP AFTER WRITING 1024. LOCATIONS 
(COND (UPWARDS-P 

(CC-WRITE-FUNC-DEST CONS-FUNC-DEST-LC 0) ; FIRST ADDRESS, SHIFTED OVER 
(CC-WRITE-FUNC-DEST CONS-FUNC-DEST-VMA 1„1 4 . ) ; ADDRESS INCREMENT (MAGIC NUMBER) 
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(CC-WRITE-Q VALUE -INC) 
(CC-WRITE-MD VALUE)) 
(T 
(CC-WRITE-FUNC-DEST CONS-FUNC- DEST-LC 1777_14. ); FIRST ADDRESS, SHIFTED OVER 
(COWRirE-FUNODEST CONS-FUNC-DEST-VMA -1.14.) {ADDRESS INCREMENT (MAGIC NUMBER] 
(CC-WRITE-Q (- VALUU-INC)) 

(CC-WRITE-MD (+ VALUE (* 2000 VALUE-1NC) ) ) ) ) 
(CC-RUN-TEST-LOOP 0'j) 

(DECLARE (SPECIAL SPY-MODE SPY-CLK SPY-FLAG-1) (FIXNUM (SPY-READ FIXNUM))) 

(DEFUN CC-RUN-TEST-LOOP (ADR) 
(CC-WRITE-PC ADR) 

(CC-NOOP-CLOCK) ; FIRST INSTRUCTION TO IR 

(CC-CLOCK) ; CLOCK AGAIN 

(SPY-WRITE SPY-MODE (LOGIOR CC-MODE-REG 10)) ;ENABLE STAT HALT 
(SPY-WRITE SPY-CLK 1) ;TAKE OFF 

(DO () ((ZEROP (BOOLE 1 4000 (SPY-READ SPY-FLAG-1)))) 
(COND ((KBD-TYI-NO-HANG) (BREAK CC-RUN-TEST-LOOP)) 

(T (PROCESS-SLEEP 15. "Await Stat Halt")))) ;AWAIT STAT HALT 
) 



((OA-REG-HIGH) LC) 

((06M) 0@A STAT-BIT) ;HALT HERE WHEN DONE, C(A) TO G@A, O0M, 

(JUMP-NOT-EQUAL MO 0@A 1Q) 

((0@A) Q-R) 

((MD) ADD MD 08A) 

((O0A) VMA) 

((LC) ADD LC 0@A) 

(JUMP 0) 
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SCAN A-MEMORY, LC HAS ADDRESS SHIFTED INTO SOURCE FIELD, 

VMA IS ADDED TO LC EACH TIME AROUND THE LOOP, STOP VIA THE STATISTICS COUNTER, 

MD HAS VALUE TO BE CHECKED FOR, Q-R GETS ADDED TO MD EACH TIME AROUND THE LOOP, 

TO DO THE ADDITIONS WE NEED SOMETHING IN A-MEM, WE CAUSE IT TO COME 

IN FROM THE PASS-AROUND PATH SO AS NOT TO TRUST THE MEMORY! 

WE BASH 'Q@A SINCE IT LOSES ANYWAY. 

HALT BY GOING INTO A LOOP WITH STAT-BIT ON IF COMPARE FAILS, GOOD DATA IN MD, 

BAD DATA IN 08M. 



1 

2 

3 

4 

5 

6 

? 

10: (JUMP 10 STAT-BIT) ;HALT HERE IF ERROR 

SCAN OUT A-MEMORY FROM 2dA THROUGH 1777SA. RETURN A LIST OF MISMATCHES 
IN THE FORM ((ADDR GOOD BAD) . ..) 
BASHES O0M AS USUAL. 0@A IS KNOWN TO BE BAD. 

WRITING INTO CONTROL MEMORY BASHES 1§A, SO WE DON'T SCAN THAT EITHER, 
(DEI-UN CC-SCAN-A-MEM (VALUE VALUE-INC) 
(CC-EXECUTE (W-C-MEM 0) 

CONS-IR-M-SRC CONS-M-SRC-LC 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-SETM 

CONS-IR-FUNC-DEST CONS-FUNC-DCST-OA-HISH) 
(CC-EXECUTE .(W-C-MEM 1) 

CONS-IR-STAT-BIT 1 

CONS-IR-A-SRC 

CONS-IR-OB C0NS-08-ALU 

■CONS-IR-ALUF CONS -ALU-SETA 

CONS-IR-M-MEM-DEST 0) 
(CC-EXECUTE (W-C-MEM 2) 1 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-M-SRC CONS-M-SRC-MD • 

CONS-IR-A-SRC 

CONS-IR-JUMP-ADDR 10 

CONS-IR-JUMP-COND CONS-OUMP-COND-M-NEQ-A 

CONS-IR-N 1) 
(CC-EXECUTE (W-C-MEM 3) 

CONS-IR-M-SRC CONS-M-SRC-Q 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-SETM 

CONS-IR-A-MEM-DEST CONS-A-MEM-DEST-INDICATOR) 
(CC-EXECUTE (W-C-MEM 4) 

CONS-IR-M-SRC CONS-M-SRC-MD 

CONS-IR~A-SRC 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-ADD 

CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD) 
(CC-EXECUTE (W-C-MEM 5) 

CONS-IR-M-SRC CONS-M-SRC-VMA 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-SETM 

CONS-IR-A-MEM-DEST CONS-A-MEM-DEST-INDICATOR) 
(CC-EXECUTE (W-C-MEM 6) 

CONS-IR-M-SRC CONS-M-SRC-LC 

CONS-IR-A-SRC 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-ADD 

CONS-IR-FUNC-DEST CONS-FUNC-DEST-LC) 
(CC-EXECUTE (W-C-MEM 7) 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-JUMP-ADDR 

CONS-IR-JUMP-COND CONS-JUMP-CGhlD-UNC 
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CONS-IR-N 1) 
(CC-EXECUTE (W-C-MEM 10) 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-JUMP-ADDR 10 

CONS-IR-JUMP-COND CONS-JUMP-COND-UNC 

CONS-IR-N 1 

CONS-IR-STAT-BIT 1) 
(DO ((ADDRESS ?.) ; LOOP REPEATS EACH TIME MACHINE HALTS 
(LOC) (GOOD) (BAD) 
(ERRORS NIL)) 

(0) 

(DECLARE (FIXNUM ADDRESS)) 

(CC-WRITE-STAT-COUNTER ("ADDRESS 1024.)) ;NUMBER OF LOCATIONS YET TO SCAN 

(CC-WRITE-FUNC-DEST CONS~FUNC~DEST~LC (LSH ADDRESS 6)) ; FIRST ADDRESS, SHIFTED OVER 

(CC-WRITE-FUNC-DEST CONS~FUNC~DEST~VMA 1_6) ;ADDRESS INCREMENT (MAGIC NUMBER) 

(CC-WRITE-Q VALUE-INC) 

(CC-WRITE-MD (+ VALUE (* VALUE-INC ADDRESS))) 

(CC-RUN-TEST-LOOP 0) ; RUN UNTIL DONE OR ERROR 

(AND (* (CC-READ-PC) 3) ;NORMAL HALT, DONE 

(RETURN (NREVERSE ERRORS))) 
(SETQ ADDRESS (1+ (logand 7777 

(ASH (CC-READ-M-MEM-CONS-M-SRC-LC) 
-6))) ;NEXT ADDRESS TO DO 

LOC (1- ADDRESS) 

GOOD (CC-READ-M-MEM CONS-M-SRC-MD) 

BAD '(CC-READ-M-MEM 0)) 
(AND CC-DIAG-TRACE (PRINT (LIST "LOC LOC 'GOOD GOOD "BAD BAD))) 
(SETQ ERRORS (CONS (LIST LOC GOOD BAD) ERRORS)))) 

(DEFtest CC-ADDRESS-TEST-A-MEM () "A-MEM" 
(DO ((SHIFT (1+ SHIFT)) 

(ADDEND (+ 1 (LSH 1 10.) (LSH 1 20.) (LSH 1 30.)) 

(+ ADDEND ADDEND)) 
(TEM)) 
((- SHIFT 10.)) 
(DECLARE (FIXNUM SHIFT ADDEND)) 
(CC-FILL-A-MEM ADDEND T) 
(COND ((SETQ TEM (CC-SCAN-A~MEM ADDEND)) 
(CC-FILL-A-MEM ADDEND NIL) 



FILL UPWARDS WITH ADDRESS 

SCAN FOR ERRORS 

GOT ERROR, FILL DOWNWARDS 



(CC-ADDRESS-TEST-ANALYZE TEM (CC-SCAN-A-MEM ADDEND) SHIFT NIL))) ;TELL RESULTS 
(CC-FILL-A-MEM -1 (- ADDEND) T) ; FILL UPWARDS WITH COMPLEMENT OF ADDRESS 

(COND ((SETQ TEM (CC-SCAN-A-MEM -1 (- ADDEND))) ;SCAN FOR ERRORS 

(CC-FILL-A-MEM -1 (- ADDEND) NIL) ;GOT ERROR, FILL DOWNWARDS 
(CC-ADDRESS-TEST-ANALYZE TEM (CC-SCAN-A-MEM -1 (- ADDEND)) 

SHIFT T))))) ;TELL RESULTS 

;THIS COULD BE MUCH HAIRIER 

(DEFUN CC-ADDRESS-TEST-ANALYZE (UPWARD-ERRORS DOWNWARD-ERRORS SHIFT COMPLEMENT-P) 
SHIFT COMPLEMENT-P ; Not used 

(DO ((L (NCONC UPWARD-ERRORS DOWNWARD-ERRORS) (CDR L)) 
(ADDRESS-AND -1) 
(ADDRESS-IOR 0) 
(DATA-BITS-IN-ERROR 0)) 
((NULL L) 
(FORMAT T "Address AND ~0 , address I0R ~0, data bits in error *.0~%" 
ADDRESS-AND ADDRESS-IOR "DATA-BITS-IN-ERROR)) 
(DECLARE (FIXNUM ADDRESS-AND ADDRESS-IOR DATA-BITS-IN-ERROR)) ; NOT TESTING C-MEM 
(SETQ ADDRESS-AND (LOGAND (CAAR L) ADDRESS-AND) 
ADDRESS-IOR (LOGIOR (CAAR L) ADDRESS-IOR) 
DATA-BITS-IN-ERROR (LOGIOR (LOGXOR (CADAR L) (CADDAR L)) DATA-BITS-IN-ERROR)))) 

;Fast address test writes zeros and ones into 2 locations 

; whose addresses differ in 1 bit, checks for interference. 

; This detects address bits stuck at zero or one for some data 

;bits, but does not detect adjacent address bits shorted together, 

(DEFtest CC-FAST-ADDRESS-TEST (MEM-NAME REGADR N-DATA-BITS N-ADDRESS-BITS) "fast Address" 

(DECLARE (FIXNUM REGADR N-DATA-BJTS N-ADDRESS-BITS)) 

(DO ((N (COND ((EQ MEM-NAME 'C-MEM) 2) ;C-MEM MAY NOT BE A POWER OF 2. CROCK. 
(T 4)) 
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(1- N)) 
(PHASE (1+ PHASE)) 
(ONES (SUB1 (EXPT 2 N-DATA-BITS))) 
(ADR-MASK (1- (EXPT 2 N-ADDRESS-BITS))) 
(ZEROS 0)) 
((■ N 0)) 
(DO ((BITNO (1+ BITNO)) 

(G00D1 (COND ((EVENP PHASE) ZEROS) (T ONES))) 
(GOOD2 (COND ((EVENP PHASE) ONES) (T ZEROS))) 
(BAD1) 
(BAD2) 
(BAD3) 
(OTHER-LQC) 
(K) 

(CC-SUSPECT-BIT-LIST)) 
((«• BITNO N-ADDRESS-BITS)) 
(SETQ K (4- REGADR (COND ((< PHASE 2) 

(LSH 1 BITNO)) 
(T (LOGXOR ADR-MASK (LSH 1 BITNO)))))) 
(SETQ OTHER-LOC (COND ((< PHASE 2) REGADR) 

(T (-t, REGADR ADR-MASK)))) 
(CC-R-D K GOOD2) 
(COND ((NOT (EQUAL (SETQ BAD2 (CC-R-E K)) GOOD2)) 

(FORMAT T "~4T~A Toe ~0" MEM-NAME (- K REGADR)) 
(CC-PRINT-BIT-LIST " fails in data bits " 

(CC-WRONG-BITS-LIST GOOD2 BAD2 N-DATA-BITS)))) 
(CC-R-D OTHER-LOC GOOD1) ;Deposit in loc second for A & M's sake 

(COND ((NOT (EQUAL (SETQ BAD1 (CC-R-E OTHER-LOC)) GOOD1)) 

(FORMAT T »'~4T~A LOC -0" MEM-NAME (- OTHER-LOC REGADR)) 
(CC-PRINT-BiT-LIST " fails in data bits " 

(CC-WRONG-BITS-LIST GOOD1 8AD1 N-DATA-BITS)))) 
(COND ((NOT (EQUAL (SETQ BAD3 (CC-R-E K)) GOOD2)) 
(FORMAT T "~A address bit ~D (-0 and -0)" 

MEM-NAME BITNO (- K REGADR) (- OTHER-LOC REGADR)) 
(CC-PRINT-BIT-LIST (IF (EVENP PHASE) " fails storing l's then in data bits " 
" fails storing then l's in data bits ") 
(CC-WRONG~BITS-LIST GO0D2 BAD3 N-DATA-BITS))))))) 

(DEFUN CC-QUIET-ADDRESS-TEST (MEM-NAME REGADR N-DATA-BITS N-ADDRESS-BITS) 
(DECLARE (FIXNUM REGADR N-DATA-BITS N-ADDRESS-BITS) ) 

(DO ((N (COND ((EQ MEM-NAME 'C-MEM) 1) ;C-MEM MAY NOT BE A POWER OF 2. CROCK. 
(T 4)) 
(1- M)) 
(PHASE (1+ PHASE)) 
(ONES (SUB1 (EXPT 2 N-DATA-BITS))) 
(ADR-MASK (1- (EXPT 2 N-ADDRESS-BITS))) 
(ZEROS 0)) 
((■ N 0)) 
(DO ((BITNO (1+ BITNO)) 

(GOOD (COND ((EVENP PHASE) ONES) (T ZEROS))) 
(OTHER-LOC) 
(K) 

(CC-SUSPECT-BIT-LIST)) 
((- BITNO N-ADDRESS-BITS)) 
(SETQ K (+ REGADR (COND ((< PHASE 2) 

(LSH 1 BITNO)) 
(T (LOGXOR ADR-MASK (LSH 1 BITNO)))))) 
(SETQ OTHER-LOC (COND ((< PHASE 2) REGADR) 

(T (+ REGADR ADR-MASK)))) 
(CC-R-D K GOOD)))) 

;Test an bits of memory for ability to retain O's, l's. Then try O's 1rt 

; even addresses, l's in odd ones. 

(DEFUN CC-GROSS-DATA-TEST (MEM-NAME REGADR N-DATA-BITS N-ADDRESS-BITS 

^OPTIONAL (MAX-ERRORS 5.) &AUX CC-SUSPECT-BIT-LIST) 
(*CATCH 'EXIT 
(DO ((N 3 (1- N)) 

(ONES (SUB1 (EXPT 2 N-DATA-BITS))) 
(ZEROS 0) 
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(HIADR (+ REGADR (EXPT 2 N-ADDRESS-BITS))) 
(ERRORS 0)) 
((- NO)) 
(DO ((ADR REGADR (+ ADR 2)) 

(EVEN-DATA (COND ((«■ N 2) ZEROS) 
((« N 1) ONES) 
(T ZEROS))) 
(ODD-DATA (COND ((■ N 2) ZEROS) 
((■ N 1) ONES) 
(T ONES)))) 
(.(>■ ADR HIADR) 
(DO ((ADR REGADR (+ ADR 2)) 
(TEM)) 
((>■ ADR HIADR)) 
(COND ((NOT (■ (SETQ TEM (CC-R-E ADR)) EVEN-DATA)) 

(FORMAT T "~%Wrote ~0 in "locn -0 of ~0, read ~S losing bits " 

EVEN-DATA (- ADR REGADR) MEM-NAME TEM) 
(CC-PRINT-BIT-LIST NIL (CC-WRONG-BITS-LIST EVEN-DATA TEM N-DATA-BITS) ) 
(COND ((> (SETQ ERRORS (1+ ERRORS)) MAX-ERRORS) 
(•THROW 'EXIT NIL))))) 
(COND ((NOT (■ (SETQ TEM (CC-R-E (1+ ADR))) ODD-DATA)-) 

(FORMAT T "~%Wroto -0 in locn -0 of ~0, read ~S losing bits" 

ODD-DATA (1+ (- ADR REGADR)) MEM-NAME TEM) 
(CC-PRINT-BIT-LIST NIL (CC-WRONG-BITS-LIST ODD-DATA TEM N-DATA-BITS)) 
(COND ((> (SETQ ERRORS ( 1+ ERRORS)) MAX-ERRORS) 
(•THROW "EXIT NIL))))))) 
(CC-R-D ADR EVEN-DATA) 
(CC-R-D (1+ ADR) ODD-DATA))))) 

(DEFUN CC-WRONG-BITS-LIST (GOOD BAD N-DATA-BITS) 
(DO ((BITNO (1+ BITNO)) 

(PPSS 0001 (+ 100 PPSS)) 
(L NIL)) 
((- BITNO N-DATA-BITS) L) 
(OR (- (LOGLDB PPSS GOOD) (LOGLDB PPSS BAD)) 
(SETQ L (CONS BITNO L))))) 

(DEFtest CC-TEST-SPC-POINTER () "SPC Pointer" 
(PROG (USP READ GOOD) • . 

(SETQ USP (CC-READ-MICRO-STACK-PTR)) 
(DOTIMES (C 32,) 

(CC-EXECUTE (WRITE) 

CONS-IR-M-SRC CONS-M-SRC-MD ;PUSH IT 
CONS-IR-ALUF CONS-ALU-SETM 
CONS-IR-OB CONS-OB-ALU 

CONS-IR-FUNC-DEST CONS-FUNC-DEST-MICRO-STACK-PUSH) 
(SETQ READ (CC-READ-MICRO-STACK-PTR)) 
(COND ((NOT (- (SETQ GOOD (LOGAND 37 (+ (1+ C) USP))) READ)) 

(FORMAT T "~%SPC PTR INCREMENT FAILED, WAS ~0, SHOULD BE ~0" READ GOOD)))) 
(SETQ USP (CC-READ-MICRO-STACK-PTR)) 
(DOTIMES (C 32.) 

(CC-EXECUTE (WRITE) 

CONS-IR-M-SRC CONS-M-SRC-MICRO-STACK-PGP 
CONS-IR-ALUF CONS-ALU-SETM 
CONS-IR-OB CONS-OB-ALU) 
(SETQ READ (CC-READ-MICRO-STACK-PTR)) 
(COND ((NOT (« (SETQ GOOD (LOGAND 37 (- USP (1+ C)))) READ)) 

(FORMAT T "~%SPC PTR' DECREMENT FAILED, WAS -0, SHOULD BE ~0" READ GOOD)))) 
)) 

(DEFUN CC-WRITE-ZERO-SPC (&OPTIONAL (V 0)) 
(DO ()((KBD-TYI-NO-HANG)) 

(CC-WRITE-MD V) ;GET DATA INTO MRD 
(CC-EXECUTE (WRITE) 

CONS-IR-M-SRC CONS-M-SRC-MD ;PUSH IT 

CONS-IR-ALUF CONS-ALU-SETM 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-FUNC-DEST CONS-FUNC-DEST-MICRO -STACK-PUSH) ) ) 
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;;; CADR SHIFTER TEST ~*-USP-*~ 

(DECLARE (FIXNUM SPY-IR-LQW (SPY-READ FIXNUM)) 
(NOTYPE (SPY-WRITE FIXNUM FIXNUM)) 
(SPECIAL SPY-IR-LOW) 
(*EXPR SPY-READ SPY-WRITE)) 

(DEFtest CC-TEST-SPY-IR () "Spy IR" 

(DOLtST (PART " (SPY-IR-HIGH SPY-IR-MEO SPY-IR-LOW)) 
(DOLIST (BACKGROUND ''(0 177777)) 
(DO ((I (1+ I)) 

(BIT 1 (ASH BIT 1))) 

((*] I 16.)) 
(LET ((PATTERN (LOGXOR BIT BACKGROUND))) 
(SPY-WRITE (SYMEVAL PART) PATTERN) 
(CC~NOOP~DEBUG~CLOCK) 

(LET ((ACTUAL (SPY-READ (SYMEVAL PART)))) 
(OR (- ACTUAL PATTERN) 

(FORMAT T "-&SPY-IR - Wrote: ~G, Read: ~Q" PATTERN ACTUAL)))))))) 

(DEFMACRO ADD2.L (ITEM LIST) 

'(OR (NUMERIC-LIST-MGMQ .ITEM .LIST)'' 
(SE1Q .LIST (CONS .ITEM .LIST)))) 



(DECLARE (SPECIAL CC-SU3PECT-8IT-LIST) ) 
(DEFtest CC-TEST-SMIFTER '() "Shifter" 

"Algorithm is to shift floating ones and' zeros with all possible shifts. 
Record hits that failed at shifter input, at shifter output, between 
the two shifter stages, and also which shift counts fail. Note that 
if the masker proms aren't plugged in, selecting the 32-bit-wide b.yta 
will work anyway du& to pullups. Prom problems will show up as failure 
of particular bits at the shifter output, you can try unplugging the 
offending prom. To reduce randomness we bring in 
on the A-source. This is now written so that it works whether or 
not. proms are present, it addresses in the right mask which is all l's 
and 37 in the left mask which is also all l's." 
(CC-WRITE-A-MEM 2 0) 
(DO ((INPUT-ERRONEOUS-ZEROS NIL) 

(MIDDLE-ERRONEOUS-ZEROS NIL) 

(OUTPUT-ERRONEOUS-ZEROS NIL) 

(INPUT-ERRONEOUS-ONES NIL) 

(MIDDLE- ERRONEOUS-ONES NIL) 

(OUTPUT-ERRONEOUS-ONES NIL) 

(ERRONEOUS-SHIFT-COUNTS NIL) 

(CC-SUSPECT-BIT-LIST NIL) 

(B1TNO (It BITNO))) ; THE FLOATING BIT 
((" BITNO 32.) 

(TERPRI) 

(CC-PRINT-BIT-LIST "Shift counts with erroneous bits: " ERRONEOUS-SHIFT-COUNTS) 

(CC-PRINT-BIT-LIST "M bits with erroneous zeros: " INPUT-ERRONEOUS-ZEROS) 

(CC-PRINT-BIT-LIST "SA bits with erroneous zeros: " MIDDLE-ERRONEOUS-ZEROS) 
■(CC-PRINT-BIT-LIST "R bits with erroneous zeros: *' OUTPUT-ERRONEOUS-ZEROS) 

(CC-PRINT-BIT-LIST "M bits with erroneous ones: " INPUT-ERRONEOUS-ONES) 

(CC-PRINT-BIT-LIST "SA bits with erroneous ones: " MIDDLE-ERRONEOUS-ONES) 

(CC-PRINT-BIT-LIST "R bits with erroneous ones: " OUTPUT-ERRONEOUS-ONES)) 
(DO ((BACKGROUND 37777777777 0)) ;FIRST FLOATING ZEROS, THEN FLOATING ONES 

(()) 

(DECLARE (FIXNUM BACKGROUND)) 

(CC-WRITE-MD (LOGXOR BACKGROUND (ASH 1 BITNO))) ;SHIFTER INPUT 
(CC-EXECUTE C0NS-1R-0P CONS-OP-BYTE ; INST TO SHIFT BY INTO IR 

CONS-Ift-A-SRC 2 

CONS-IR-M-SRC CONS-M-SRC-MD 

CGNS-IR-BYTL-1 3 7 

CONS-IR-MROT 

CONS-IR-BYTC-FUNC CONS-8YTE-FUNC-LDB) ;LDB * SR, NOT. MR 
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(DO ((MROT (1+ MROT)) 
(BAD) 

(CORRECT-IR (SPY-READ SPY-IR-LOW) (1+ CORRECT-IR)) 
(GOOD (LOGXOR BACKGROUND (ASH 1 BITNO)) {EXPECTED OUTPUT 
(ROT32 GOOD 1))) 
((■ MROT 32.)) 
(DECLARE (FIXNUM MROT GOOD BAD)) 

(COND ((NOT (» (SETQ BAD (CC-READ-OBUS) ) GOOD)) ;HA! AN ERROR, STASH STUFF AWAY 
(IF-FOR-LISPM 
(COND (CC-DIAG-TRACE 

(FORMAT T "~&Rot: -0, Bit: ~0, Good: -0, Bad: -0, Reread: ~0" 
MROT (ASH 1 BITNO) GOOD BAD (CC-READ-OBUS) )) )) 
(ADD2L MROT ERRONEOUS-SHIFT-COUNTS) 
(DO ((J (1+ J)) ;BITS OF OUTPUT 

(GOOD GOOD (ASH GOOD -1)) 
(BAD BAD (ASH BAD -1))) 

((- J 32.)) 
(OR (■ (LOGAND 1 GOOD) (L06AND 1 BAD)) 

(COND ((ZEROP (LOGAND 1 GOOD)) ;AN ERRONEOUS ONE 
(ADD2L J OUTPUT-ERRONEOUS-ONES) 

(ADDZL (LOGAND (- J MROT) 37) INPUT-ERRONEOUS-ONES) 
(ADD2L (LOGAND (- J (LOGAND MROT -4)) 37) MIDDLE-ERRONEOUS-ONES)) 
(T 
(ADD2L J OUTPUT-ERRONEOUS-ZEROS) 

(ADD2L (LOGAND (- J MROT) 37) INPUT-ERRONEOUS-ZEROS) 
(ADD2L (LOGAND (- J (LOGAND MROT -4)) 37) MIDDLE-ERRONEOUS-ZEROS) 

)))))) 
(SPY-WRITE SPY-IR-LOW (1+ (SPY-READ SPY-IR-LOW))) {INCREMENT MROT FIELD 
(CC-NOOP-DEBUG-CLOCK) 

(LET ((ACTUAL-IR (SPY-READ SPY-IR-LOW))) ;D1d the IR get written correctly? 
(COND ((NOT (- (1+ CORRECT-IR) ACTUAL-IR)) 

(FORMAT T "~&Debug IR - Correct: ~0, Read back: ~0" 
(1 + CORRECT-IR) ACTUAL-IR))))) 
(AND (ZEROP BACKGROUND) (RETURN NIL))))) 

;; With the shift data paths known to work, read out all elements of the left 
;; mask and verify that they contain the correct contents. We continue to 
;; select location of the right mask, which is all 1's. 
;; It may be helpful to pull out the- right-mask proms at this stage. 
(DEFUN CC-TEST-MASK-LEFT () 
(CC-WRITE-A-MEM 10) 
(CC-WRITE-M-MEM 2 37777777777) 
((LAMBDA (TEM) 

(DECLARE (FIXNUM TEM)) 
(SETQ TEM (CC-READ-A-MEM 1)) 
(OR (■ TEM) 

(ERROR • |1n ISA - should be 0| TEM 'FAIL-ACT)) 
(SETQ TEM (CC-READ-M-MEM 2)) 
(OR (• 37777777777 TEM) 

(ERROR * | 1n 2@M ~ should be 37777777777| TEM 'FAIL-ACT)) 
(DO ((BYTL-1 (1+ BYTL-1)) 

(GOOD 1 (1+ (ASH GOOD 1)))) 
((■ BYTL-1 32.)) 
(DECLARE (FIXNUM BYTL-1 GOOD)) 
(CC-EXECUTE CONS-IR-OP CONS-OP-BYTE 
CONS-IR-A-SRC 1 
CONS-IR-M-SRC 2 
CONS-IR-BYTL-1 BYTL-1 
CONS-IR-MROT 

CONS-IR-BYTE-FUNC CONS-BYTE-FUNC-LDB) ; LDB * SR, NO MR 
(SETQ TEM (CC-READ-OBUS)) 
(AND ( A Z TEM GOOD) 

(FORMAT T "~%BYTL-l«-0, MROT«~0, Left Mask-~0, should be -0~X M 
BYTL-1 MROT TEM GOOD)))) 
;Paren above, far right should match with A Y(lambda (tern) 
0)) 

;; With the shift data paths and the 'left mask known to work, read out 
;; all locations of the right mask and verify that they are correct. 
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;; Here wo hold the left mask at all l's, which incidentally tests its 
; ; address adder, 
(DEFUN CC-TEST-MASK-RIGHT () 
(COWRITE-A-MEM 1 0) 
(CC-WRITE-M-MEM 2 37777777777) 
((LAMBDA (TEM) 

(DECLARE (FIXNUM TEM)) 
(SETQ TEM (CC-READ-A-MEM 1)) 
(OR (" TEM) 

(ERROR ' |1n ISA - should be 0| TEM 'FAIL-ACT)) 
(SETQ TEM (CC-READ-M-MEM 2)) 
(OR (- 37777777777 TEM) 

(ERROR '| in 2@M - should be 37777777777) TEM 'FAIL-ACT)) 
(DO ((MROT (1+ MROT)) ; right mask address 

(BYTL-1 37 (1- BYTL-1)) -.keeps the left mask address * 37 
(GOOD 37777777777 (LOGXOR GOOD (ASH 1 MROT)))) 
((- MROT 32,)) 
(DECLARE (FIXNUM MROT BYTL-1 GOOD)) 
(CC-EXECUTE CQNS-IR-OP CONS-OP-BYTE 
CONS-IR-A-SRC 1 
CONS-IR-M-SRC 2 
CONS-IR-BYTL-1 BYTL-1 
CQNS-IR~MROT MROT 

CONS-IR-BYTE-FUNC CONS-BYTE-FUNC-SELECTIVE-DEPOSIT) ;MR, NO SR 
(SETQ TEM (CC-READ-OBUS)) 
(AND ( A Z TEM. GOOD) 

(FORMAT T "~%BYTL-1"~0, MROT— 0, Right Mask— 0, should be -0-/6" 
BYTL-1 MROT TEM GOOD)))) 
;Paren above, far right should match with A Y(lambda (tern) 
0)) 

Verify that the masker works. This finds things like broken wires on 
the mask inputs to the 9S42's, 

The somewhat simple-minded algorithm is to make the masker select all M 
and make sure no bits from A get OR'ed in,. then select all A and make sure 
no bits fjrom M get OR'ed in. 
(DEFtest CC-TEST-MASKER (') "Masker" 
(LET ((CC-SUSPECT-BIT-LIST NIL)) 
(CC-WRITE-A-MEM 1 37777777777) 
(CC-WRITE-M-MEM 2 0) 
(CC-EXECUTE CONS-IR-OP CONS-OP-BYTE 
CONS-IR-A-SRC 1 
CQNS-IR-M-SRC 2 
CONS-IR-BYTL-1 37 
CONS-IR-MROT 

CONS-IR-BYTE-FUNC CONS-BYTE-FUNOSELECT1VE-DEPOSIT) 
(CC-PRINT-BIT-LIST "Erroneous A bits coming through masker:" 

(CC-WRONG-BITS-LIST (CC~READ~QBUS) 32.)) 
(LET ((RH 0) (LH 0)) 

(DECLARE (FIXNUM LH RH)) 
(CC-WRITE-A-MEM 1 0) 
(CC-WRITE-M-MEM 2 37777777777) 

(CC-EXECUTE CONS-IR-OP CONS-OP-BYTE ;Select A in the right half 
CONS-IR-A-SRC 1 
CONS-IR-M-SRC 2 
CONS-IR-BYTL-1 17 
CONS-IR-MROT 20 

CONS-IR-BYTE-FUNC CONS-BYTE-FUNC-SELECTIVE-DEPOSIT) 
(SETQ RH (CC-READ-OBUS)) 

(CC-EXECUTE CONS-IR-OP CONS-OP-BYTE ;Select A in the left half 
CONS-IR-A-SRC 1 
CONS-IR-M-SRC 2 
CONS-IR-BYTL-1 17 
CONS-IR-MROT 

CONS-IR-BYTE-FUNC CONS-BYTE-FUNC-SELECTIVE-DEPOSIT) 
(SETQ LH (CC-READ-OBUS)) 
(CC-PRINT-BIT-LIST "Erroneous M bits coming through masker:" 

(CC-WRONG-BITS-LIST (DPB (LDB 2020 LH) 2020 RH) 32.))))) 
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With the normal shift and mask logic known to work, test LC-modif icatlon. 
Things to test are whether both ftalfwords and all 4 bytes properly mung 
the MROT field. Doesn't currently test whether automatic fetching. 
Does test LC incrementing, Eventually that should be tested. 
Should test LC A Y VMA data path. 
(DEFUN CC-TEST-LC-AFFECTS-SHIFT () 
(CC-WRITE-A-MEM 1 0) 
(CC-WRITE-M-MEM 2 37777777777) 

(CC-WRITE-FUNC-DEST CONS-FUNC-DEST-INT-CNTRL 1_29.) ;Put machine in byte mode 
(DO ((LC 1 (1+ LC)) 

(LC-READBACK (+ 1.31. 1J29 . 1) ( 1+ LC-READBACK)) ;Needfetch, Byte Mode, 1 
(GOOD 377 (ASH GOOD 8)) 
(TEM)) 
■((- LC 5)) 
(DECLARE (FIXNUM LC LC-READBACK GOOD TEM)) 

(CC-WRITE-FUNC-DEST CONS-FUNC-DEST-LC LC) ;Select byte (initially rightmost, LOcurrent+1) 
(SETQ TEM (CC-READ-M-MEM CONS-M-SRC-LC) ) 
(IF (*Z TEM LC-READBACK) 

(FORMAT T "~&~4TWrona, value in LC, is ~0, but should be ~0" TEM LC-READBACK)) 
(CC~EXECUTE CONS-IR-OP CONS-OP-BYTE 
CONS-IR-A-SRC 1 , 
CONS-IR-M-SRC 2 
CONS-IR-BYTL-1 7 
CONS-IR-MROT 
CONS-IR-MF 3 

CONS-IR-BYTE-FUNC CONS-BYTE-FUNC-SELECTIVE-DEPOSIT) ;MR, NO SR 
(SETQ TEM (CC-READ-OBUS)) 
(IF (*Z TEM GOOD) 

(FORMAT T "~&~4T LC*~0 (byte mode), shifter output-~0, should be ~0" 
LC-READBACK TEM GOOD))) 
(CC-WRITE-FUNC-DEST CQNS-FUNC-DEST-INT-CNTRL 0_29.) ;Put machine in word mode 
(DO ((LC 2 (+ LC 2)) 

(LC-READBACK (+ 1„31. 2) (+ LC-READBACK 2)) ;Needfetch, no Byte Mode, 2 (-1 wd) 
(GOOD 177777 (ASH GOOD 16.)) 
(TEM)) 
((- LC 4)) 
(DECLARE (FIXNUM LC LC-READBACK GOOD TEM)) 

(CC-WRITE-FUNC-DEST CONS-FUNC-DEST-LC LC) ;Select halfword (initially rightmost, LC«current+l) 
(SETQ TEM (CC-READ-M-MEM CONS-M-SRC-LC) ) 
(IF {-l TEM LC-READBACK) 

(FORMAT T "~%Wrong value in LC, is ~0, but should be -0" TEM LC-READBACK)) 
(CC-EXECUTE CONS-IR-OP CONS-OP-BYTE . 
CONS-IR~A-SRC 1 
CONS-IR-M-SRC 2 
CONS-IR~BYTL~l 17 
CONS-IR-MROT 
CONS-IR-MF 3 

CONS-IR~BYTE~FUNC CONS-BYTE-FUNC-SELECTIVE-DEPOSIT) ;MR, NO SR 
(SETQ TEM (CC~READ»OBUS)) 
(AND (NOT (- TEM GOOD)) 

(FORMAT T "~%LO~0 (halfword mode), shifter output*~Q, should be -0" 
LC-READBACK TEM GOOD))) 
(CC-WRITE-FUNC-DEST CONS-FUNC-DEST-INT-CNTRL 1JZ9.) ;Put machine in byte mode 
(DOTIMES (B 24.) 

(LET ((GOOD (ASH IB)) 
(TEM NIL)) 
(CC-WRITE-FUNC-DEST CONS-FUNC-DEST-LC (1- GOOD)) 
(CC-SAVE-MICRO-STACK) 
(SETQ CC-SAVED-MICRO-STACK-PTR 0) 
(AS-1 40000 CC-MICRO-STACK 0) 
(CC-RESTORE-MICRO-STACK) 
(CC-EXECUTE (WRITE) 

CONS-IR-OP CONS-OP-JUMP 
CONS-IR-R 1 

CQNS-IR-JUMP-COND CONS-JUMP-COND-UNC) 
(COND ((NOT (* (SETQ TEM (LOfiAND 77777777 (CC-READ-M-MEM CONS-M-SRC-LC) ) ) 
GOOD)) 
(FORMAT T "~%LC failed to Increment properly good -0, bad -0" GOOD TEM))))) 
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; ; ; CADR DISPATCH TEST 

;; Fill all of D memory with its own address, and no RPN bits 
(DEFUN CC-FILL-D-MEM-W-ADR () 
(DC) ((I (1+ I))) 
((» I 2048.)) 
(DECLARE (FIXNUM I)) 
(CC-WRJTE-D-MEM I I))) 

;; Read back all possible bytes with MROT*0, make sura right address 
;; conies back into the PC. Here we always use a disp addr of 0. 
(DEFtest CC-TEST-DISPATCH (&aux tern) "Dispatch" 
(CC-FILL-D-MEM-W-ADR) 
(DO ((BYTL (1+ BYTL)) 

(MXVAL 1 (* MXVAL 2)) 
(OK-CNT 0) 
(ERR-CNT 0)) 
((- BYTL 8.) 
(COND ((NOT (ZEROP ERR-CNT)) 

(FORMAT T "~°/,~S TRIALS OK". OK-CNT)))) 
(DECLARE (FIXNUM BYTL MXVAL)) 
(DO ((VAL (1+ VAL)) 
(PC)) 
((■ VAL MXVAL)) 
(DECLARE (FIXNUM VAL PC)) 

(CC-WRITE-MD (~ VAL MXVAL)) ;Turn on extra bits to detect improper masking 
(CC-EXECUTE CONS-IR-QP CONS-OP-DISPATCH ;Execute a dispatch 
CONS-IR-M-SRC CONS-M-SRC-MD 
CONS-IR-DISP-BYTL BYTL 
CONS-IR-DISP-ADDR 0) 
;At this point the disp is in IR but has not yet been executed. 
(CC-CLOCK) ;Clock it so PC loads from disp mem 

(SETQ PC (CC-READ-PC)) 

(IF (« PC VAL) ; Read the right location 
(INCF OK-CNT) 
(INCF ERR-CNT) ; Read the wrong. location [Else clauses] 
(FORMAT T "~%Dispatch error, BYTL--0, M-~0, DPO-O, but should be -O" 
BYTL 

(LOGAND 37777777777 (- VAL MXVAL)) 
PC 

VAL)))) 
(cc-write-d-mem (dpb 1 cons~disp~p-bit (dpb 1 cons-disp-n-bit 0))) 
(do ((cnt (1+ cnt)) 

(adr (Ish 1 cnt))) 
((- adr 20000)) 
(cc-execute (w-c~mem adr) 

cons-ir-op cons-op-dispatch 
cons-ir-disp-lpc 1 
cons-ir-disp-bytl 
cons-ir-disp-addr 0) 
(cc-save-micro~ stack) 
(setq cc-saved-micro-stack-ptr 0) 
(as-1 -1 cc-micro-stack 0) 
(as-1 "1 cc-micro-stack 1) 
( cc~ r es tor e-micro-s tack) 
(cc-write-pc adr) 

(cc-noop-clock) ;dispatch inst'to IR 
(cc-c'lock) ;execute it 
(cc-noop-clock) ;write spc 
(cc-save-micro-stack) 
(cond ((not (- cc-saved-micro-stack-ptr 1)) 

(format t "~%D ispatch push failed to advance USP ~0" cc-saved-micro-stack-ptr))) 
(cond ((not (■ (setq tern (ar-1 cc-micro-stack 1)) adr)) 

(format t n ~%Dispatch push own address at adr -0 pushed ~0 instead" adr tem))) 
(cc-exacute (w-c~mem adr) 

cons-ir-op cons-op-dispatch 
cons-ir-disp-bytl 
cons-ir-disp-addr 0) 
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(cc-save-micro- stack) 

(setq ec-saved-micro-stack-ptr 0). 

(as-1 -1 cc-micro-stack 0) 

(as-1 -1 cc-micro~stack 1) 

(cc- res tore-micro- stack) 

(cc-write-pc adr) 

(cc-noop-clock) ; dispatch inst to IR 

(cc-clock) ;execute it 

(cc-noop-clock) ;write spc 

(cc-save-micro- stack) 

(cond ((not (« cc-saved-micro-stack-ptr 1)) 

(format t "~%Dispatch push failed to advance USP -0" cc-saved-micro-stack-ptr))) 
(cond ((not (* (setq tern (ar-1 cc-micro~stack 1)) (1+ adr))) 

(format t "~%Dispatch next address at adr ~0 pushed ~0 instead" adr tern)))) 
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(DEFVAR CC-DIA6-TRACE NIL "Value of T prints all errors as they occur.") 

(DECLARE (FIXNUM IJKMN NBITS BITNO REGADR PPS5 SHIFT RELAD) 

(SPECIAL CC-SUSPECT-BIT-LIST CC-DIAG-TRACE CC-TEST-ADR-BARFED) ) 

(DEFtest CC-TEST-M-MEM-ADR () "M-MEM Address" 

(CC-TEST-ADR "M-MEM" RAMMO 32. 32. 1)) ;COMMENT. REGADR, WIDTH, ft REGISTERS, INITIAL 

{RELATIVE TEST ADR; M DOCSNT WIN SINCE IT GETS CLOBBERED BY 
;CC~R~D WHEN WRITING THE MD. 

(DEFtest CC-TEST-A-MEM-ADR () "A-MEM Address" 

(CC-TEST-ADR "A-MEM" RAAMO 32. 1024. 1)) ; LIKEWISE, A LOSES. 

(DEFtest CC-TEST-PDL-ADR () "PDL Address" 

(CC-TEST-ADR "PDL-BUFFER" RAPBO 32. 1024. 0)) 
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;Data test, using progressive shifts of the address and complement of address as data 
(DEFUN CC-TEST-ADR (MESSAGE REGADR NBITS NREG IRELAD) 
(COND ((<■ NBITS 30.) {FOR SPEED, FIXNUM CASE IS SEPARATE 
(DO ((PHASE NIL (NOT PHASE)) - • 

(I (IF PHASE (1+ I) I)) 
(ONES (1- (ASH 1 NBITS))) 
(SHIFT) 
(ACTUAL) 

(CC-TEST-ADR-BARFED NIL) 
(ERRORS 0) 

(ADDRESS-LENGTH (HAULONG NREG))) 
((" I NBITS)) 
(DECLARE (FIXNUM I SHIFT ONES ACTUAL)) ;This won't win for c-mem, 

; but its sooo slow otherwise 
(SETQ SHIFT (IF PHASE (- NBITS ADDRESS-LENGTH I) I)) 
(FORMAT T "~&Data is address shifted ~D places" SHIFT) 
(DO RELAD IRELAD ( 1+ RELAD) (■ RELAD NREG) 

(CC-R-D (+ REGADR RELAD) (LOGAND ONES (ASH RELAD SHIFT)))) 
(DO RELAD IRELAD (1+ RELAD) (■ RELAD NREG) 

(COND ((NOT (- (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) • 
(LOGAND ONES (ASH RELAD SHIFT)))) 
(SETQ ERRORS (1+ ERRORS)) 

(CC-TEST-ADR-BARF MESSAGE RELAD (LOGAND ONES (ASH RELAD SHIFT)) ACTUAL)))) 
(DO RELAD IRELAD (1+ RELAD) (■ RELAD NREG) 

(CC-R-D (+ REGADR RELAD) (LOGAND ONES (ONES-COMPLEMENT (ASH RELAD SHIFT))))) 
(DO RELAD IRELAD (1+ RELAD) (■ RELAD NREG) 

(COND ((NOT (- (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) 

(LOGAND ONES (ONES-COMPLEMENT (ASH RELAD SHIFT))))) 
(SETQ ERRORS (1+ ERRORS)) 

(CC-TEST-ADR-BARF MESSAGE RELAD (LOGAND ONES (ONES-COMPLEMENT (ASH RELAD SHIFT))) 
ACTUAL)))) 
;IF THERE WERE ERRORS, GO THRU THE OPPOSITE DIRECTION TO ATTEMPT TO DETERMINE 
; THE HIGH ADR THAT LOST. 

(COND ((NOT (ZEROP ERRORS)) 

(FORMAT T "~&Scanning down, same parameters-^") 
(DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD) 

'(CC-R-D (+ REGADR RELAD) (LOGAND ONES (ASH RELAD SHIFT)))) 
(DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD) 

(COND ((NOT (■ (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) 
(LOGAND ONES (ASH RELAD SHIFT)))) 
(SETQ ERRORS (1+ ERRORS)) 
(CC-TEST-ADR-BARF MESSAGE RELAD 

(LOGAND ONES (ASH RELAD SHIFT)) ACTUAL)))) 
(DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD) 

(CC-R-D (+ REGADR RELAD) (LOGAND ONES (ONES-COMPLEMENT (ASH RELAD SHIFT))))) 
(DO RELAD (1- NREG) (1- RELAD) (< RELAD NREG) 

(COND ((NOT .(■ (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) 

(LOGAND ONES (ONES-COMPLEMENT (ASH RELAD SHIFT))))) 
(SETQ ERRORS (1+ ERRORS)) 
(CC-TEST-ADR-BARF MESSAGE RELAD 

(LOGAND ONES (ONES-COMPLEMENT (ASH RELAD SHIFT))) 
ACTUAL)))) 
(TERPRI))) 

)) 

(T ;NON-FIXNUM CASE 
(DO ((SHIFT (1+ SHIFT)) 

(SHIFTMPY 1 (PLUS SHIFTMPY SHIFTMPY)) 

(ONES (DIFFERENCE (DPB 1 (+ (LSH NBITS 6) 0001) 0) 1)) 
(ACTUAL) 

(CC-TEST-ADR-BARFED NIL) 
(ERRORS 0)) 
((* SHIFT NBITS)) 
(DO RELAD IRELAD (1+ RELAD) (■ RELAD NREG) 

(CC-R-D (+ REGADR RELAD) (TIMES RELAD SHIFTMPY))) 
(DO RELAD IRELAD (1+ RELAD) (- RELAD NREG) 

(COND ((NOT (EQUAL (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) 
(TIMES RELAD SHIFTMPY))) 
(SETQ .ERRORS (1+ ERRORS)) 
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(CC-TEST-ADR-BARF MESSAGE RELAD (TIMES RELAD SHIFTMPY) ACTUAL)))) 
(DO RELAD IRELAD (1+ RELAD) (» RELAD NREG) 

(CC-R-0 (+ REGADR RELAD) (DIFFERENCE ONES (TIMES RELAD SHIFTMPY)))) 
(DO RELAD IRELAD (1+ RELAD) (- RELAD NREG) 

(COND ((NOT (EQUAL (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) 

(DIFFERENCE ONES (TIMES RELAD SHIFTMPY)))) 
(SETQ ERRORS (1+ ERRORS)) 

(CC-TEST-ADR-BARF MESSAGE RELAD (DIFFERENCE ONES (TIMES RELAD SHIFTMPY)) 
ACTUAL)))) 
;IF THERE WERE ERRORS, GO THRU THE OPPOSITE DIRECTION TO ATTEMPT TO DETERMINE 
; THE HIGH ADR THAT LOST. 

(COND ((NOT (ZEROP ERRORS)) 

(PRINC "SCANNING DOWN, SAME PARAMETERS") 

(TERPRI) 

(DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD) 

(CC-R-D (+ REGADR RELAD) (TIMES RELAD SHIFTMPY))) 
(DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD) 

(COND ((NOT (EQUAL (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) 
(TIMES RELAD SHIFTMPY))) 
(SETQ ERRORS (1+ ERRORS)) 

(CC-TEST-ADR-BARF MESSAGE RELAD (TIMES RELAD SHIFTMPY) ACTUAL)))) 
(DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD) 

(CC-R-D (+ REGADR RELAD) (DIFFERENCE ONES (TIMES RELAD SHIFTMPY)))) 
(DO -RELAD (1- NREG) (1- RELAD) (< RELAD NREG) 

(COND ((NOT (EQUAL (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) 

(DIFFERENCE ONES (TIMES RELAD SHIFTMPY)))) 
(SETQ ERRORS (1+ ERRORS)) 
(CC-TEST-ADR-BARF MESSAGE RELAD 

(DIFFERENCE ONES (TIMES RELAD SHIFTMPY)) 
ACTUAL)))) 
(TERPRI))) 

)))) 

(DEFUN CC-TEST-ADR-BARF (MESSAGE RELAD GOOD BAD) 
(AND (NOT CC-TEST-ADR-BARFED) 

(SETQ CC-TEST-ADR-BARFED T) 

(FORMAT T "-Mrror while address-testing: ~A~%" MESSAGE)) 
(FORMAT T "Relative address: -0; wrote ~G; read ~0~%" GOOD RELAD BAD)) 

(DEFUN CC-ASSURE-C-MEM-ZERO (&OPTIONAL (START 0)(END 20000)) 
(DO ((ADR START (1+ ADR)) 
(C-MEM-CONTENTS) ' 

(C-MEM-HIGH) (C-MEM-MEDIUM) (C-MEM-LOW) 
(HIGH-BAD-AND 177777) 
(MEDIUM-BAD-AND 177777) 
(LOW-BAD-AND 177777) 
(HIGH-BAD-OR 0) 
(MEDIUM-BAD-OR 0) 
(LOW-BAD-OR 0) 
(BAD-ADDRESS-AND 177777) 
(BAD-ADDRESS-OR 0)) 
((>* ADR END) (FORMAT T "~%AND of non-zero locations: ~0~%QR of non-zero locations: -0 
AND of bad addresses: ~0~%OR of bad address: ~0" 

(■+ (ASH HIGH-BAD-AND 40) (ASH MEDIUM-BAD-AND 20) LOW-BAD-AND) 
(+ (ASH HIGH-BAD-OR 40) (ASH MEDIUM-BAD-OR 20) LOW-BAD-OR) 
BAD-ADDRESS-AND 
BAD-ADDRESS-OR)) 
(COND ((NOT (7.EROP (SETQ C-MEM-CONTENTS (CC-READ-C-MEM ADR)))) 
(SETQ BAD-ADDRESS-AND (LOGAND BAD-ADDRESS-AND ADR) 
BAD-ADDRESS-OR (LOGIOR BAD-ADDRESS-OR ADR) 
C-MEM-HIGH (LDB 4020 C-MEM-CONTENTS) 
C-MEM-MEDIUM (LDB 2020 C-MEM-CONTENTS) 
C-MEM-.LOW (LDB 0020 C-MEM-CONTENTS)) 
(SETQ HIGH-BAD-AND (LOGAND HIGH-BAD-AND C-MEM-HIGH) 

MEDIUM-BAD-AND (LOGAND MEDIUM-BAD-AND C-MEM-MEDIUM) 
LOW-BAD-AND (LOGAND LOW-BAD-AND C-MEM-EOW) 

HIGH-BAD-OR (LOGIOR HIGH-BAD-OR C-MEM-HIGH) 
MEDIUM-BAD-OR (LOGIOR MEDIUM-BAD-OR C-MEM-MEDIUM) 
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L0W-8AD-0R (LOGIOR LOW-BAD-OR C-MEM-LOW)))))) 

;CC-ZERO-C-MEM defined in LMCONS;ZERO 
(DEFUN CC-ZERO-C-MEM-CONTINUOUS () 
(CC-EXECUTE (W-C-MEM 0) 

CONS-IR-OP CONS-OP-BYTE 

CONS-IR-M-SRC CONS-M-SRC-MD 

CONS-IR-A-SRC 1 

CONS-IR-BYTE-FUNC CONS-BYTE-FUNC-DPB 

CONS-IR-MROT 12. 

CONS-IR-BYTL-1 13. 

CONS-IR-FUNC-DEST CONS-FUNC-DEST-OA-LQW) 
(CC-EXECUTE (W-C-MEM 1) 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-A-SRC 1 ; VALUE TO WRITE (HIGH) 

CONS-IR-M-SRC 1 ; VALUE TO WRITE (LOW) 

CONS-IR-JUMP-ADDR 

CONS-IR-JUMP-COND CONS-JUMP-COND-UNC 

CONS-IR-R 1 

CONS-IR-P 1 

CONS-IR-N 1) 
(CC-EXECUTE (W-C-MEM 2) 

CONS-IR-STAT-BIT 1 

CONS-IR-M~SRC CGNS-M-SRC-MD 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-M+1 

C0N5-IR-FUNC-DEST CONS-FUNC-DEST-MD) 
(CC-EXECUTE (W-C-MEM 3) 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-JUMP-ADDR 

CONS-IR-JUMP-COND CONS-JUMP-COND-UNC 

CONS-IR-N 1) 
(UNTIL-KEY 

(CC-WRITE-STAT-COUNTER -16380.) ;STOP AFTER WRITING 16K-4 LOCATIONS 
(CC-WR1TE-M-MEM 1 0) 
(CC-WRITE-MD 4) STARTING AT 4 
(CC-RUN-TEST-LOOP 0)) 
) 

(DEFUN CC-TEST-C-MEM-PARITY-CHECKER NIL 
(DO ((BIT (1+ BIT)) 
(OUAN)) 
((■ BIT 47.)) 
(CC-WRITE-C-MEM (SETQ QUAN (ASH 1 BIT))) 
(CC-EXECUTE (WRITE) 

CONS-IR-OP CONS-OP- JUMP ;DO JUMP INSTRUCTION TO DESIRED PLACE 
CONS-IR-JUMP-ADDR 

CONS-IR-JUMP-COND CONS-JUMP-COND-UNC) 
(COND ((NOT (■ QUAN (CC-READ-IR))) 

(FORMAT T "~%~WROTE ~0 READ ~0" QUAN (CC-READ-IR)))) 
(CC-NOOP-CLOCK) 
(COND ((NOT (ZEROP (LQGLDB 601 (SPY-READ SPY-FLAG-1) ))) 

(FORMAT T "~7oparity checker failed BIT ~D," BIT))))) 

(DEFUN CC-MEM-TEST-LOOP (ADR &OPTI0NAL WRITE-DATA READ-ALSO) 
(COND (WRITE-DATA 

(DO ((WORD)) ((KBD-TYI-NO-HANG) (PHYS-MEM-READ ADR)) 
(AND WORD (RETURN-ARRAY WORD)) 
(PHYS-MEM-WRITE ADR WRITE-DATA) 

(AND READ-ALSO (SETQ WORD (PHYS-MEM-READ ADR))))) 
(T 
(DO ((WORD)) ((KBO-TYI-NO-HANG) WORD) 
(AND WORD (RE TURN- ARRAY WORD)) 
(SETQ WORD (PHYS-MEM-READ ADR)))))) 

(DEFUN CC-MEM-ZERQ (FROM TO) 
(DO ((ADR FROM (1+ ADR))) 

((OR (KBD-TYI-NO-HANG) (> ADR TO)) ADR) 
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(PHYS -MEM-WRITE ADR 0))) 

;;; Perform a read or write, check specified status bits. 
(DEFUN DC-CLP-NXM (&AUX STATUS) 
(DO () (( KBD-TYI-NO-HANG) STATUS) 

(PHYS-MEM-WRITE DC-CLP-ADR 400000) 

(PHYS-MEM-WRITE DC-CMD-ADR 0) ■ 

(PHYS-MEM-WRITE DC-START-ADR 0) 

(DO () ((LDB-TEST 0001 (SETQ STATUS (PHYS-MEM-READ DC-STS-ADR) )))))) 

(DEFUN CC-MEM-FILL (FROM TO &OPTIONAL (WORD 0) (FUNCTION (FUNCTION 1+))) 
(DO ((ADR FROM (1+ ADR)) 

(WORD WORD (FUNCALL FUNCTION WORD))) 
((OR (KBD-TYI-NO-HANG) (> ADR TO)) ADR) 
(PHYS-MEM-WRITE ADR WORD))) 

(DEFUN CC-MEM-FILL-CHECK (FROM TO ^OPTIONAL (WORD 0) (FUNCTION (FUNCTION 1+))) 
(DO ((ADR FROM (1+ ADR)) 
(MEM-WORD 0) 

(WORD WORD (FUNCALL FUNCTION WORD))) 
((OR (KBD-TYI-NO-HANG) (> ADR TO)) ADR) 
(OR (» (SETQ MEM-WORD (PHYS-MEM-READ ADR)) WORD) 

(FORMAT T "Compare error: Adr— 0, is ~0 but should be -0-%" ADR MEM-WORD WORD)))) 

(DEFUN CC-MEM-TEST-ONE-WORD-TQ-DISK (ADR &OPTIONAL (WORD 0) 

PRINT-FLAG (FUNCTION (FUNCTION 1+))) 
(DO ((CORE-PAGE (// ADR 400)) 

(WORD WORD (FUNCALL FUNCTION WORD))) 
((KBD-TYI-NO-HANG) WORD) 

(AND PRINT-FLAG (PRINC WORD) (PRINC " ")) 
(PHYS-MEM-WRITE ADR WORD) 
(CC-DISK-WRITE 1 CORE-PAGE 1))) 

(DEFUN CC-MEM-READ-DISK (ADR) 

(CC-DISK-READ 1 (// ADR 400) 1)) 

(DEFUN CC-DISK-REPEAT-OP (CORE-PAGE &OPTIONAL SLEEP-TIME 

ERROR-PRINT-FLAG (FCN CC-DISK-WRITE-FCN)) 
(PHYS-MEM-WRITE' 12 (LSH CORE-PAGE 8)) 
(DO ((STATUS)) 

((KBD-TYI-NO-HANG)) 

(AND SLEEP-TIME (PROCESS-SLEEP SLEEP-TIME) "CC Disk Oporation" 

(PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 0) FCN) ;Store command, does reset 

(PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 1) 12) ;Store CLP 

(SETQ CC-DISK-LAST-CMD FCN CC-DISK-LAST-CLP 12) 

(PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 2) 1) ;Disk adr: always track 0, head 0, sector 1 

(PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 3) 0) ;Start transfer 

(DO () ((NOT (ZEROP (LDB 0001 (SETQ STATUS (PHYS-MEM-READ CC-DISK-ADDRESS))))))) 

(COND ((AND ERROR-PRINT-FLAG 

(NOT (ZEROP (LOGAND STATUS 47777660)))) 
; ERROR BITS: INTERNAL PARITY, NXM, MEM PAR, HEADER COMPARE, 
; HEADER ECC, ECC HARD, ECC SOFT, READ OVERRUN, WRITE OVERRUN, 
; START-BLOCK ERR, TIMEOUT, SEEK ERR, OFF LINE, OFF CYL, FAULT, 
; NO SEL, MUL SEL 
(CC-DISK-ANALYZE)))))) 

; ; MAP FIRST ?.56K VIRTUAL MEMORY TO PHYSICAL MEMORY 
(DEFUN CC-LOAD-STRA1GHT-MAP (^OPTIONAL (PAGE-OFFSET 0)) 
(DO ((L-2 (1+ L-2))) 
(( A ] L-2 1024.)) 

(CC-WRITE-LEVEL-2-MAP L-2 (+ 60000000 L-2 PAGE-OFFSET))) 
(DO ((L-l (1+ L-l))) 
((*] L-l 40)) 
(CC-WRITE-LEVEL-1-MAP L-l L-l)» 

(DEFMACRO CC-MEMORY-BANK (VMA) 
'(LDB 161?. ,VMA)) 
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(DEFUN CC-PARITY-SWEEP-INFO (PHYS-ADR-LIST 

&OPTIONAL FIX-SINGLE-BIT-ERRORS (PRINT-AREA-SYMBOL T)) 
(DO ((L PHYS-ADR-LIST (CDR L)) 

(PHYS-ADR) (VIRT-ADR) (AREA-NUMBER) (AREA-SYMBOL) (CORE) (DISK)) 
((NULL L) NIL) 
(SETQ PHYS-ADR (CAR L) VIRT-ADR (QF-VIRT-ADR-OF-PHYS-ADR PHYS-ADR)) 
(COND ((NULL VIRT-ADR) 

(FORMAT T "~%~0: not found in PHT" PHYS-ADR)) 
((■ (LDB 1020 VIRT-ADR) %PHT-DUMMY-VIRTUAL-ADDRESS) 

(FORMAT T "~ D /=~0: which is a free page of core" PHYS-ADR)) 
(T 
(SETQ AREA-NUMBER (QF-AREA-NUMBER-QF-POINTER VIRT-ADR) 
AREA-SYMBOL 
(COND (PRINT-AREA-SYMBOL 

(READLIST (CC-Q-EXPLODE (QF-MEM-READ (+ (QF-INITIAL-AREA-ORIGIN 

'AREA-NAME) 
AREA-NUMBER))))))) 
(FORMAT T "~%~0: Virtual adr -0, Area -S " PHYS-ADR VIRT-ADR AREA-SYMBOL) 
(FORMAT T " Core copy ~0, Disk copy ~Q bits:" 
(SETQ CORE (QF-MEM-READ VIRT-ADR)) 
(SETQ DISK (QF-MEM-READ- DISK-COPY VIRT-ADR))) 
(CC-PRINT-BITS (LOGXOR CORE DISK)) 
(IF (AND FIX-SINGLE-BIT-ERRORS 

T ;(SINGLE~BIT-P (LOGXOR CORE DISK)) 

) 
(PROGN (FORMAT T "^Fixing locn «o to ~o" phys-adr disk) 
(PHYS-MEM-WRITE PHYS-ADR DISK))))))) 

(DEFUN COPARITY-SWEEP (&OPTIONAL (NUMBER-OF-MEMORIES 2) 

VERBOSE-P FIX-ERRORS-P 
(FIRST-ADDRESS 0) 
&AUX (C-MEW--SAVE-LIST '(17000 17001 17002 17003))) 
(LET ((SAVED-CONTROL-MEMORY (MAPCAR #*COREAD~C-MEM C-MEM-SAVE-LIST)) 
(CURRENT-DATA-LO'GAND) (CURRENT-DATA-LOGIOR) 
(CURRENT-ADR-LOGAND) (CURRENT-ADR-LOGIOR) 
(CURRENT-BANK (CC-MEMORY-BANK FIRST-ADDRESS)) 
(ERROR-FLAG NIL) (MEM-SIZE (LSH NUMBER-OF-MEMORIES 16.)) 
(BAD-LOCS)) 
(DBG-RESET) ; TEMPORARY KLUDGE? JUST IN CASE MACHINE IS HUNG 

(CC-RESET-MACH) 

(SPY-WRITE SPY-MODE 44) ;Prom disable, errhalt 

(CC-FAST-LOAD-STRAIGHT-MAP) 
(CC-EXECUTE (W-OMEM 17000) 

CONS-IR-OP CONS-OP-ALU 
CONS-IR-M-SRC CONS-M-SRC-VMA 
CONS-IR-OB CONS-OB-ALU 
CONS-IR-ALUF CONS-ALU-M+1 

CONS-IR-FUNC-DEST CONS-FUNC-DEST-VMA-START-READ) 
(CC-EXECUTE (W-C-MEM 17001) 

CONS-IR-STAT-BIT 1) ; DELAY (NO PAGE FAULT EXPECTED) 
(CC-EXECUTE (W-C-MEM 17002) 

CONS-IR-M-SRC CQNS-M-SRC-MD 
CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-SETM) iDEST M-GARBAGE 
(CC-EXECUTE (W-C-MEM 17003) 

CONS-1R-OP CONS-OP-JUMP 
CONS-IR-JUMP-ADDR 17000 
CONS-IR-JUMP-COND CONS-JUMP-COND-UNC 
CONS-IR-N 1) 
(SETQ MEM-SIZE (* MEM-SIZE FIRST-ADDRESS)) 
(CC-WRITE-STAT-COUNTER (MINUS MEM-SIZE)) 

(CC-WRITE-FUNC-DEST CONS-FUNC-DEST-VMA (1- FIRST-ADDRESS)) 
(SETQ CURRENT-DATA-LOGAND -1 CURRENT-DATA-LOGIOR 

CURRENT-ADR-LOGAND -1 CURRENT-ADR-LOGIOR 0) 
(DO () (NIL) 

(CC-RUN-TEST-LOOP-W-ERROR-HALTS 17000) 
(LET ((VMA (CC-READ-M-MEM CONS-M-SRC-VMA)) 
(MD (CC-READ-M-MEM CONS-M-SROMD))) 
(COND (('Z (CC-MEMORY-BANK VMA) CURRENT-BANK) 
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(COND (ERROR-FLAG 

(CC-PRINT-BANK-AS-BOARD-AND-BANK CURRENT-SANK) 

(FORMAT T "~&Address LOGAND»~0, Address LOGIOR--0, Data LOGAND--0, Data LOGIGR=~0~%' 
(I.OGAND CURRENT-ADR-LOGAND (1- (ASH 1 24.))) 
CURRENT-ADR-LOGIOR 

(LOGAND CURRENT-DATA-LOGANi) (1- (ASH 1 32.))) 
CURRENT-DATA-LOGIOR))) 
(SETQ CURRENT-DATA-LOGAND -1 CURRENT-DATA-LOGIOR 
CURRENT-ADR-LOGAND -1 CURRENT-ADR-LOGIOR 
CURRENT-BANK (CC-MEMORY-BANK VMA) 
ERROR-FLAG NIL))) 
(COND ((ZEROP (CC-READ-STAT)) 
(RETURN T)) 
(T (AND VERBOSE-P 

(FORMAT T "~%VMA: -0 MD: ~0" VMA MD)) 
(SETQ ERROR-FLAG T 

CURRENT-ADR-LOGAND (LOGAND CURRENT-ADR-LOGAND VMA) 
CURRENT-ADR-LOGIOR (LOGIOR CURRENT-ADR-LOGIOR VMA) 
CURRENT-DATA-LOGAND (LOGAND CURRENT-DATA-LOGAND MD) 
CURRENT-DATA-LOGIOR (LOGIOR CURRENT-DATA-LOGAND MD) 
BAD-LOCS (QONS VMA BAD-LOCS)) 
(AND FIX-ERRORS-P 

(PHYS-MEM-WRITE VMA (PHYS-MEM-READ VMA))))))) 
(DOLIST (LOC C-MEM-SAVE-LIST) 

(CC-WRITE-C-MEM LOC (CAR SAVED-CONTROL-MEMORY)) 
(SETQ SAVED-CONTROL-MEMORY (CDR SAVED-CONTROL-MEMORY))) 
BAD-LOCS)) 

(DEFUN CC-PRINT-BANK-AS-BOARD-AND-BANK (BANK) 
(LET ((BOARD (FIX (// BANK 4)))) 

(FORMAT T "~&Bank ~0, which is Bank -0' of Board ~0 (based from zero)- 3 /." 

BANK (- BANK (* BOARD 4)) BOARD) 
T)) 

(DEFUN CC-RUN-TEST-LOOP-W-ERROR-HALTS (ADR) 
(CC-WRITE-PC ADR) 

(CC-NQOP-CLOCK) ; FIRST INSTRUCTION TO IR 

(CC-CLOCK) 'CLOCK AGAIN 

(SPY-WRITE SPY-MODE 54) {ENABLE STAT HALT, PROM DISABLE, ERR HALT 
(SPY-WRITE SPY-CLK 1) ;TAKE OFF 

(DO () ((BIT-TEST 6000 (LOGXOR 4000 (SPY-READ SPY-FLAG-1)))) 
(PROCESS-SLEEP 15. "Await Stat Halt"))) 
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;;; Function for testing and adjusting the clock 

(DEFVAR CC-ADJUST-CLQCK-ARRAY (MAKE-ARRAY 8.)) 

(DEFTEST CC --TEST-CLOCK () "Clock" 

iThese first two are to get everything paged in 
(CC-MEASURE-CLOCK 0) 
(CC-MEASURE-CLOCK 4) 
(DOTIMES (I 8.) 

(ASET (CC-MEASURE-CLOCK I) CC-ADJUST-CLOCK-ARRAY I)) 
(SEND TERMINAL-IO ' :LINE-OUT " 
Speed ILong Pin Actual Nominal") 
(do ((1 (1+ i)) 

(pins '(5D08-6 5D08-3 5D08-16 5D08-14 6D08-5 5D08-4 5D08-17 5D08-15) (cdr pins)) 
(nominals '(235. 180. 180. 160. 235. 220. 210. 200.) (cdr nominals))) 

{(■ 1 8)) 
(format t " ~D ~:[No~;Yes~] -A ~D ~D~%" 

(logand 3 i) (> i 3) (car pins) (AREF cc-adjust-dock-array i) 
(car nominals))) 
(FORMAT T "~%Also, scope clock at 5A10-11; width of low phase should be about 75 ns 
~%~4TNote that the standard cycle-time (GD08-16) has been increased to 
~4T180ns from 170ns for greater rel iabil ity.~%")) 



;Returns period in nano 

(DEFUN CC-MEASURE-CLOCK 

(CC-WRITE-MD 0) ;Wil 

(cond ((< speed-ilong 

(cc-execute co 

CO 

co 

co 

(t 

(cc-execute co 

co 

co 

co 

co 

(spy-write spy-mode ( 

(spy-write spy-elk 11 

(let ((low (%unibus-r 

(high (%unibus 

(setq start-time (d 

(PROCESS-SLEEP 60, "M 

(SPY-WRITE SPY-CLK 10 

(SPY-WRITE SPY-MODE 



seconds 

(SPEED-ILONG &AUX START-TIME END-TIME) 
1 count cycles 

4) 



ns 



ir-m~src cons~mrsrc~nid 
ns-ir-ob cons-ob-alu 
ns-ir-aluf cons-alu-M+1 
ns-ir-func-dest cons-func-dest-md)) 



(LET ((LOW (%UNIBUS-r 

(high (%unibus- 

(setq end-time (dpb 

(// (* (cond ((> end- 

(t (.+ (- 

1000.) 

(cc-read~m-mem cons-m-sre-md))) 



ns-ir-ilong 1 

ns-ir-m-src cons-m-sre-md 

ns-ir-ob cons-ob-a1u 

ns-ir-aluf cons-alu-M+1 

ns-ir-func-dest cons-func-dest-md))) 

logand 3 speed-ilong) ). ;Set speed, clear errstop, etc. 

) ;Set RUN and DEBUG 

ead 764120)) ;Hardware synchronizes if you read this one first 

read 764122))) 

pb high 2007 low))) 

easure Clock") 

) -.Clear RUN, but leave DEBUG set 

) ;Dont leave that random speed in there. The cc~read~m-mem 

; may cause randomness if you do. 
ead 764120)) ;Hardware synchronizes if you read this one first 
read 764122))) 

high 2007 lew))) 
time start-time) (- end-time start-time)) 

end-time start-time) 1J23.))) 
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Testing of instruction-modif icatlpn paths. The general methodology is 
to execute an instruction which has an OA destination, 
then read back the IR. With one side of the IOB or-gates held low we 
test the bits on the other side. First we put the OA-modifying instruction into 
the IR, then we put the desired value for the I lines into the DEBUG-IR 
then do a DEBUG-CLOCK. 
(DEFtest CC-TEST-OA-REGS () "OA Registers" 

(CC-TEST-OA-REG "OA-REG-LOW" CONS-FUNC-DEST-OA-LOW 26. 1 0) 
(CC-TEST-OA-REG "OA-REG-LOW" CONS-FUNC-DEST-OA-LOW 26. 1) 
(CC-TEST-OA-REG "OA-REG-HIGH" CONS-FUNC-DEST-OA-HIGH 26. 22, 1 0) 
(CC-TEST-OA-REG "OA-REG-HIGH" CONS-FUNC-DEST-OA-HIGH 26. 22. 1)) 

;;; Float a 1 bit through and complain about wrong l's or 0*s 
;;; Conceivably could float 0's also, 

(DEFUN CC-TEST-OA-REG (MESSAGE DEST FIRST-IR-BIT N-BITS IR-BIT M-BIT) 
(DO ((N N-BITS (1- N)) 

(IR-BIT (ASH IR-BIT FIRST-IR-BIT) (ASH IR-BIT 1)) 
(M-BIT M-BIT (ASH M-BIT 1)) 
(BITNO (1+ BITNO)) 
(GOOD) (BAD) 

(CC-SU5PECT-BIT-LIST NIL)) 
((ZEROP N)) 
(CC-WRITE-MD M-BIT) 
(CC-EXECUTE 

CONS-IR-M-SRC CONS-M-SRC-MD 
CONS-IR-OB CONS-OB-ALU 
CONS-IR-ALUF CONS-ALU-SETM 
C0NS-IR-FUNC-DE5T DEST) 
(CC-WRITE-DIAG-IR IR-BIT) 
(CC-DEBUG-CLOCK) 

;; IR should now have OR of M-BIT and IR-BIT 
(SETQ GOOD (LOGIOR IR-BIT (ASH M-BIT FIRST-IR-BIT)) 

BAD (CC-READ-IR)) 
(COND ((NOT (- GOOD BAD)) 

(FORMAT T "-&~4T«A failure: IR-BIT is ~D, M-BIT is ~D "MESSAGE IR-BIT M-BIT) 
(COND ((ZEROP IR-BIT) 

(FORMAT T "OB has 1 in bit ~D" BITNO) 
(IF (NOT (ZEROP FIRST-IR-BIT)) 

(FORMAT T " (» ~D)" (+ BITNO FIRST-IR-BIT))) 
(SEND TERMINAL-IO ': STRING-OUT ", I" ) ) 
(T (FORMAT T "I has 1 in bit -D, OB M (+ BITNO FIRST-IR-BIT)))) 
(IF (ZEROP BAD) 

(SEND TERMINAL-IO ':LINE~OUT " has zero. IR got zero") 
(CC-PRINT-BIT-LIST " has zero. , 1-bits in IR: " 

(CC-WRONG-BITS-LIST BAD 48.))))))) 

(DEFVAR CC-RANDOM-DATA-ARRAY NIL) 

(DEFVAR CC-RANDOM-DATA-ARRAY-COMPLEMENTED NIL) 

;This one takes a while. Run it when you are out to lunch. 

(DEFtest CC-C~MEM-BLOCK-ADDRESS~TEST (&OPTIONAL (ISA 0)) "C-MEM Block Address" 
(COND ((NULL CC-RANDOM-DATA-ARRAY) 

(SETQ CC-RANDOM-DATA-ARRAY (MAKE-ARRAY NIL ART-Q 400)) 

(SETQ C'C-RANDOM-DATA-ARRAY-COMPLEMENTED (MAKE-ARRAY NIL ART-Q 400)) 

(DO I (1+ I) ■(«■ I 400) 

(AS-1 (LOGXOR (AS-1 (DPB (RANDOM 200000) 

4020 

(DPB (RANDOM 200000) 
2020 

(RANDOM 200000))) 
CC-RANDOM-DATA-ARRAY 

I) 
7777777777777777) 

CC-RANDOM-DATA-ARRAY-COMPLEMENTED 

I)))) 
("CATCH 'BLOCK-TEST 

(DO SA ISA (+ SA 400) (* SA 40000) 
(CC-CMB-TEST SA)))) 
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(DEFUN CC-CMB-TEST (SA) 

(CC-CMB-WRITE-BLOCK SA CC-RANDOM-DATA-ARRAY) 

(COND ((NOT (ZEROP (CC-CMB-TEST-BLOCK SA CC-RANDOM~DATA-ARRAY) ) ) 
(FORMAT T "~%400 wd block at ~0 doesnt retain data" SA)) 
(T (CC-CMB-ZAP SA SA 0) 

(CC-CMB-ZAP SA (+ SA 400) 40000 0) 

(COND ((NOT (ZF.ROP (CC-CMB-TEST-BLOCK SA CC-RANDOM-DATA-ARRAY))) 

(FORMAT T "~%400 wd block at ~Q changed by writing 0's elsewhere" SA))) 
(CC-CMB-ZAP SA SA -1) 
(CC-CMB-ZAP SA (+ SA 400) 40000 0) 
(COND ((NOT (ZEROP (CC-CMB-TEST-BLOCK SA CC-RANDOM-DATA-ARRAY))) 

(FORMAT T "~%400 wd block at -O changed by writing l's elsewhere" SA))) 
(CC-CMB-WRITE-BLOCK SA CC-RANDOM-DATA-ARRAY-COMPLEMENTED) 
(COND ((NOT (ZEROP (CC-CMB-TEST-BLOCK SA CC-RANDOM-DATA-ARRAY-COMPLEMENTED) ) ) 

(FORMAT T "-'MOO wd block at -0 doesn't retain (complemented) data" SA))) 
(CC-CMB-ZAP SA SA 0) 
(CC-CMB-ZAP SA .(+ SA 400) 40000 0) 

(COND ((NOT (ZEROP (CC-CMB-TEST-BLOCK SA CC-RANDOM-DATA-ARRAY-COMPLEMENTED))) 
(FORMAT T "~%400 wd block at -0 changed by writing 0's elsewhere (COM)" 
SA))) , 
(CC-CMB-ZAP SA SA -1) 
(CC-CMB-ZAP SA (+ SA 400) 40000 0) 

(COND ((NOT (ZEROP (CC-CMB-TEST-BLOCK SA CC-RANDOM-DATA-ARRAY-COMPLEMENTED) ) ) 
(FORMAT T "~%400 wd block at ~0 changed by writing l's elsewhere(COM)" 
SA)))))) 

(DEFUN CC-CMR-ZAP (SA FROM TO DATA) 
(COND ((KBD-TYI-NO-HANG) 

(FORMAT T "~%WAS TESTING BLOCK AT ~S" SA) 
(♦THROW 'BLOCK-TEST NIL))) 
(CC-WRITE-A-MEM 1 (LOGLDB 4020 DATA)) ; ISA GETS HIGH 16 BITS 

■(CC-WRITE-M-MEM (DPD (LDB 2020 DATA) 2020 (LDB 0020 DATA))) ;0®M GETS LOW 32 BITS 
(DO I FROM (1+ I) (NOT (< I TO)) 
(CC-EXECUTE (WRITE) 

CONS-IR-OP CONS-OP-JUMP ;EXECUTE MAGIC FLAVOR OF JUMP INSTRUCTION 

CONS-IR-JUMP-ADDR I 

CONS-IR-P 1 ;R+P*WRITE C MEM 

CONS-IR-R 1 

CONS-IR-A-SRC 1 

;CONS-IR~M-SRC 

CONS-IR-JUMP-COND CONS-JUMP-COND-UNC) ) ) 

(DEFUN CC-CMB-WRITE-BLOCK (SA ARY) 
(DO I (1+ I) (- I 400) 

(CC-WRITE-C-MEM (+ SA I) (AR-1 ARY I)))) 

(DEFUN CC-CMB-TEST-BLOCK (SA ARY &AUX (ERRS 0) RES) 
(DO ((I (1+ I))) 
((OR (■ I 400) 

(AND (NULL CC-DIAG-TRACE) 
(NOT (ZEROP ERRS)))) 
ERRS^ 
(COND ((NOT (- (SETQ RES (CC-REAO-C-MEM (+ SA I))) (AR-1 ARY I))) 
(SETQ ERRS (1+ ERRS)) 
(COND (CC-DIAG-TRACE 

(FORMAT T "~7oADR:~0 READ -0, SHOULD BE ~0" (+ I SA) RES (AR-1 ARY I)))))))) 

;ALU TESTS 

(DEFtest CC-TEST-INCREMENTER () "Incremanter" 
(DO ((BIT (1+ BIT)) 
(DAT) 
(RES)) 
((- BIT 32.)) 
(CC-WRITE-M-MEM 1 (1- (SETQ DAT (ASH 1 BIT)))) 
(CC-EXECUTE 
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CONS-IR-OP CONS-OP-ALU 
CONS-IR-M-SRC 1 
CONS-IR-06 CONS-OB-ALU 
CONS-IR-ALUF CONS-ALU-M+1) 
(COND ((NOT (■ (SETQ RES (CC-REAO-OBUS)) DAT)) 

(FORMAT T n ~%Increment1ng bit ~D, got ~o instead of ~o" BIT RES DAT))))) 

(DEFtest CC-TEST-ARITH-COND-JUMP () "Arithmetic Conditional Jump" 
(DO ((BIT (1+ BIT)) 
(DAT)) 
((- BIT 31.)) 
(SETQ DAT (ASH 1 BIT)) 
(CC-WRITE-M-MEM 1 DAT) 
(CC-WRITE-M-MEM 2 (1- DAT)) 
(CC-WRITE-M-MEM 3 (MINUS DAT)) 
(CC-WRITE-M-MEM 4 (MINUS (1- DAT))) 
(DO ((I 1 (1+ I))) 
((• I 4)) 
(CC-TEST-JUMP-INTERNAL I I CONS-JUMP-COND-M-A "M=A" T) 
(CC-TEST-JUMP-INTERNAL I I CONS-JUMP-COND-M<A "M<A" NIL) 
(CC-TEST-JUMP-INTERNAL I I CONS-JUMP-COND-M>A "M>A" NIL) • 
(CC-TEST-JUMP-INTERNAL I I CONS-JUMP-COND-M<-A "M<*A" T) 
(CC-TEST-JUMP-INTERNAL I I CONS-JUMP-COND-M>-A "M>«A" T)) 
(CC-TEST-JUMP-1 2 1) 
(CC-TEST-JUMP-1 3 4))) 

(DEFUN CC-TEST-JUMP-1 (LESS MORE) 

(CC-TEST-JUMP-INTERNAL LESS MORE CONS-JUMP~COND-M<A "M<A" T) 

(CC-TEST-JUMP-INTERNAL MORE LESS CONS.-JUMP-COND-M<A "M<A" NIL) 

(CC-TEST-JUMP-INTERNAL LESS MORE CONS-JUMP-COND-M>A "M>A" NIL) 

(CC-TEST-JUMP-INTERNAL MORE LESS CONS-JUMP-COND-M>A "M>A" T)) 

(DEFUN CC-TEST-JUMP-INTERNAL (M-ADR A-ADR JUMP-COND STRING SIIOULD-JUMP 
&AUX NPC JCOND WILL-JUMP ERR) 
(CC-WRITE-PC 0) 
(CC-EXECUTE 

CONS-IR-OP CONS-OP-JUMP 1 

CONS-IR-M-SRC M-ADR 

CONS-IR-A-SRC A-ADR ■ . 

CONS-IR-JUMP-COND JUMP-COND 
CONS-IR-JUMP-ADDR 777) 
(SETQ JCOND (LDB 0201 (SPY-READ SPY-FLAG-2) ) ) 
(SETQ WILL-JUMP (NOT (OR (AND (NOT (ZEROP JCOND)) (ZEROP (LDB 0601 JUMP-COND))) 

(AND (ZEROP. JCOND) (NOT (ZEROP (LDB 0601 JUMP-COND))))))) 
(COND ((EQ WILL-JUMP SHOULD-JUMP) 

(FORMAT T "~%JCOND incorrect before clock") ;notel dont believe this error too much, 
(SETQ ERR T))) 
(CC-CLOCK) 

(SETQ NPC (CC-READ-PC)) 
(COND ((NOT (- NPC (COND (SHOULD-JUMP 777) (T 2)))) 

(FORMAT T "-"/.JUMP FAILED: M-.-O, A*~0, COND ~A, NPO~0 H 
(CC-READ-M-MEM M-ADR) 
(CC-READ-A-MEM A-ADR) 
STRING 
NPC)) 
(ERR (FORMAT T "~%Actua1 jump OK: M--0, A-~0, COND -A, NPC— 0" 
(CC-READ-M-MEM M-ADR) 
(CC-READ-A-MEM A-ADR)" 
STRING 
NPC)))) 

;Use this to try to find slow ALU bits with a scope. 

(DEFUN CC-ALU-SPEED-TEST (&OPTIQNAL (A-VALUE 0) (M-VALUE 0) (A-REG 2) (M-REG 30)) 
(PROG (CH FROB-M) 

(CC-STOP-MACH) 
(CC-EXCCUTE (W-OMEM 100) 

CONS-IR-SPARE-BIT 1 : f or scope trigger 
CONS-IR-OP CONS-OP-JUMP 
CONS-IR-A-SRC A-REG 
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CONS-IR-M-SRC M-REG 

CONS-IR-JUMP-COND CONS-JUMP-COND-M-A 

CONS-IR-N 1 

CONS-IR-JUMP-ADDR 200) 
(CC-EXECUTE (W-C-MEM 101) ) 
(CC-EXECUTE (W-C-MEM 102) 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-JUMP-COND CONS-JUMP-CQND-UNC 

CONS-IR-N 

CONS-IR~JUMP-ADDR 100) 
(CC-EXECUTE (W-C-MEM 103) 

CONS-IR-OP CONS-OP-ALU 

CONS-IR-M-SRC 1 

CQNS-IR-M-MEM-DEST 1 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-M+1 
) 

(CC-EXECUTE (W-C-MEM 200) 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-JUMP-COND CON5-JUMP-COND-UNC 

CONS-IR-N 

CONS-IR-JUMP-ADDR 100) 
(CC-EXECUTE (W-C-MEM 201) 

CONS-IR-OP CONS-OP-ALU 

CONS-IR-M-SRC 3 

CONS-IR-M-MEM-DEST 3 

CQNS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-M+1 

) 
(CC-WRITE-A-MEM A-REG A--VALUE) 
(CC-WRITE-M-MEM M-REG M-VALUE) 
(SETQ CH (CC-RUN-LOOP 100)) 
(COND ((MEMQ CH ' (#/a #/A)) 
(SETQ FROB-M NIL)) 
((MEMQ CH '(#/m #m)) 
(SETQ FROB-M T))) 
(COND (FROB-M 

(COND ((■ CH #/+) (SETQ M-VALUE (1+ M-VALUE))) 

((■ CH #/"X) (SETQ M-VALUE (ASH M-VALUE 1))) 
((- CH 0/"Y) (SETQ M-VALUE (ASH M-VALUE -1))) 
;0-R (- CH tt/z) (- CH #/l)) (SETQ M-VALUE 0)))) 



(T 



)) 



(FORMAT 
(GO L) 



( 

(COND ( 

( 

( 

( 
T "~%M- VALUE - -0, A-VALUE * -0" M-VALUE A-VALUE) 



■ CH #/+) (SETQ A-VALUE (1+ A-VALUE))) 
- CH #/~X) (SETQ A-VALUE (ASH A-VALUE 1))) 
« CH #/~Y) (SETQ A-VALUE (ASH A-VALUE -1))) 
OR (-.CH #/z) (« CH if/1)) (SETQ A-VALUE 0))))) 



(DEFUN CC~RUN-LOOP (ADR &AUX CH) 
(CC-WRITE-PC ADR) 

(CC-NOOP-CLOCK) ; FIRST INSTRUCTION TO IR 

(CC-CLOCK) ;CLOCK AGAIN 

(SPY-WRITE SPY-CLK 1) ; TAKE OFF 
(DO () ((SETQ CH (KBD-TYI-NO-NANG))) 

(PROCESS-SLEEP 15. "Running Loop")) 
(CC-STOP-MACH) 
CH) 

(DEFtest CC-TEST-PC-INCREMENTER NIL "PC Incremented' 
(DOTIMES (B 14.) 

(CC-TEST-PC-INCREMENT (1- (LSH 1 B)))) 
(DOTIMES (B 13.) 

(CC-TEST-PC-INCREMENT (- (LSH 1 (1+ B)) 2)))) 

(DEFUN CC-TEST-PC-INCREMENT (VAL) 
(CC-WRITE-PC VAL) 
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(CC-NOOP-DEBUG-CLOCK) 

(COND ((NOT ( = (CC-READ-PC) (1+ VAL))) 

(FORMAT T *'-% PC of ~0 incremented to ~0" VAL (CC-READ-PC))))) 

(DEFUN CC-TEST-USTACK-TO-PC (N) 

(LET ((USP-(CC-READ-MICRO-STACK-PTR)) 
(VAL)) 
(CC-WRITE-MD N) ; GET- DATA INTO MRD 
(CC-EXECUTE (WRITE) 

CONS-IR-M-SRC CONS-M-SRC-MD ; PUSH IT 
CONS-IR-ALUF CONS-ALU-SETM 
CONS-IR-OB CONS-OB-ALU 

CONS-IR-FUNC-DEST CONS-FUNC-DEST-MICRO-STACK-PUSH) 
(CC-EXECUTE 

CONS-IR-OP CONS-OP-JUMP 
CONS-IR-JUMP-COND CONS-JUMP-COND-UNC 
CONS-IR-R 1) 
(CC-CLOCK) 

(SETQ VAL (CC-READ-PC)) 
(COND ((NOT (« USP (CC-READ-MICRO-STACK-PTR))) 

(FORMAT T "~%USP ~0 BEFORE PUSH, POP; -0 AFTER" 
USP (CC-READ-MICRO-STACK-PTR)))) 
VAL)) 

(DECLARE (SPECIAL SPY-OPC SPY-OPC-CONTROL)) 

(DEFUN CC-TEST-OPC-TRIAL (N &AUX TEM) 
(DOTIMES (C 8) 

(CC-WRITE-PC (+ N C))) 
(DOTIMES (C 8) 

(SETQ TEM (SPY-READ SPY-OPC)) 
(COND ((NOT (« TEM (+ N C))) 

(FORMAT T "~%OPC #~D, Wrote -0 ;read ~0" C (+ N C) TEM))) 
(SPY-WRITE SPY-OPC-CONTROL 2) ;CL0CK OPCS 
(SPY-WRITE SPY-OPC-CONTROL 0))) 

(DEFUN CC-PRINT-OPCS-LOOP NIL 
(DO () (()) 

(PRINT (SPY-READ SPY-OPC)) 

(SPY-WRITE SPY-OPC-CONTROL 2) ;CLOCK OPCS 

(SPY-WRITE SPY-OPC-CONTROL 0))) 

(DEFUN CC-SETUP-DIVIDE-TEST () 

"Load C-MEM with divide routine... 
Divide two numbers. This routine taken from UCADR 108. 

Dividend in 22, divisor in 23 (same values as M-l and M~2 for randomness). 
Quotient In Q-R, remainder 22. 
Clobbers 1000@A. Zeros 2@M, ZBA" 
(CC-WRITE-M-MEM 2 0) 
(CC-EXECUTE (W-C-MEM 0) ; HALT . in 

CONS-IR-OP CONS-OP-JUMP 

CQN5-IR-MF CONS-MF-HALT 

CONS-IR-JUMP-ADDR 

CONS-IR-JUMP-COND CONS-JUMP-COND-UNC 

CONS-IR-N 1) 
(CC-EXECUTE (W-C-MEM 6)) ;a couple of no-ops to get started by 
(CC-EXECUTE (W-C-MEM 7)) 
(CC-EXECUTE (W-C-MEM 10) ; ( JUMP~GREATER-OR~EQUAL~XCT~NEXT M-l A-2ERO DIV1) 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-M-SRC 22 

CONS-IR-A-SRC 2 

CONS-IR-JUMP-ADDR 13 

CONS-IR-JUMP-COND CONS~JUMP~COND-M>-A 

CONS-IR-N 0) 
(CC-EXECUTE (W-C-MEM 11) ; ((A-TEM1 Q-R) M-l) 

CONS-IR-M-SRC 22 

CONS-IR-A-MEM-DEST (+ CONS-A-MEM-DEST-INDICATOR 1000) 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-SETM 
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CONS-IR 

(CC-EXECUTE 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 

(CC-EXECUTE 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 
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(CC-EXECUTE 
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CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 

(DOTIMES (C 
(CC-EXECU 
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CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 

(CC-EXECUTE 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 

(CC-EXECUTE 
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CONS-IR 
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(CC-EXECUTE 
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CONS-IR 
CONS-IR 

(CC-EXECUTE 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 

(CC-EXECUTE 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 

(CC-EXECUTE 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 
CONS-IR 

(CC-EXECUTE 



-Q CONS-Q-LOAD) 

(W-C-MEM 12) 
-M-SRC 2 
-A-SRC 1000 
~OB CONS-OB-ALU 

ALUF CONS-ALU-SUB 

Q CONS-Q-LOAD) 

(W-C-MEM 13) 

M-SRC 2 

A-SRC 23 

OB CONS-OB-ALU-LEFT-1 

M-MEM-DEST 22 

ALUF CONS-ALU-DFSTEP 

Q CONS-Q-LEFT) 

(W-C-MEM 14) ;DIV1A 

OP CONS-OP-JUMP 

M-SRC CONS-M-SRC-Q 



;((Q-R) SUB M-ZERO A-TEM1) 



;DIV1 ((M-l) DIVIDE-FIRST-STEP M-ZERO A-2) 



(JUMP-IF-BIT-SET (BYTE-FIELD 1 0) Q-R DIVIDE-BY-ZERO) 



;((M-1) DIVIDE-STEP M-l A-2) 
15)) 



;(JUMP~LESS-OR-EQUAL-XCT-NEXT M-ZERO A-TEM1 DIV2) 



-JUMP-COND ;test bit 
-JUMP-ADDR 
-P 1 
-N 1) 

31.) 
TE (W-C-MEM (+ C 
-M-SRC 22 
-A-SRC 23 

-OB CONS-OB-ALU-LEFT-1 
-M-MEM-DEST 22 
-ALUF CONS-ALU-DSTEP 
-Q CONS-Q-LEFT)) 

(W-C-MEM (+ 15 31.)) ;((M-1) DIVIDE-LAST-STEP M-l A-2) 
-M-SRC 22 
-A-SRC 23 
-OB CONS-OB-ALU 
-M-MEM-DEST 22 
-ALUF CONS-ALU-DSTEP 
-Q CONS-Q-LEFT) 

(W-C-MEM (+ 16 31.)) 
-OP CONS-OP-JUMP 
-M-SRC 2 
-A-SRC. 1000 

-JUMP-ADDR ( + 3 16 31.) 
-JUMP-COND CONS-OUMP-COND-M<*A 
-N 0) 

(W-C-MEM (+ 17 31.)) 
-M-SRC 22 
-A-SRC 23 
-OB CONS-OB-ALU 
-M-MEM-DEST 22 
-ALUF CONS-ALU-RSTEP) 

(W-C-MEM (+ 20 31.)) ;((M-1) SUB M-ZERO A-l) 
-M-SRC 2 
-A-SRC 22 
-OB CONS-OB-ALU 
-M-MEM-DEST 22 
-ALUF CONS-ALU-SUB) 

(W-C-MEM (+ 21 31.)) :DIV2 ((A-TEM1) XOR M-2 A-TEM1) 
-M-SRC 23 
-A-SRC 1000 
-OB CONS-OB-ALU 

-A-MEM-DEST ( + CONS-A-MEM-DEST-INDXCATOR' 1000) 
-ALUF CONS-ALU-XOR) 

(W-C-MEM (+ 22 31.)) ; (POPJ-LESS-QR-EQUAL M-ZERO A-TEM1) 
-OP CONS-OP-JUMP 
-M-SRC 2 

A-SRC 1000 
-JUMP-COND CONS-OUMP-COND-M<«A 
-R 1 
-N 1) 

(W-C-MEM (+ 23 31.)) ; (POPJ-AFTER-NEXT (A-TEM1) Q-R) 



;((M-1) DIVIDE-REMAINDER-CORRECTION-STEP M-l A-2) 
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CONS-IR-POPJ 1 

CONS-IR-M-SRC CONS~M-SRC~Q 

CONS-1R-A-MEM-DEST (+ COMS-A-MEM-DEST-INDICATOR 1000) 

CONS-IR-OB CONS-OB-ALU 

COMS-IR-ALUF CONS-ALU-SETM) 
(CC-EXECUTE (W-C-MEM (+ 24 31.)) :((Q"R) SUB M-ZERO A-TEM1) 

CONS-IR-M-SRC 2 

CONS-IR-A-SRC 1000 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-ALUF CONS-ALU-SUB 

CONS-IR-Q CONS-Q-LOAD) 
calling routine loop 

10000a TEM, 1OO10A dividend 10026a divisor 10030a correct remainder 
1@M counts errors. 
(CC-EXECUTE (W-C-MEM 100) 

CONS-IR-A-SRC 1001 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-M-MEM-DEST 22 

CONS-IR-ALUF CONS-ALU-SETA) 
(CC-EXECUTE (W-C-MEM 101) 

CONS-IR-A-SRC 1002 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-M-MEM-DEST 23 

CONS-IR-ALUF CONS-ALU-SETA) 
(CC-EXECUTE (W-C-MEM 102) 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-JUMP-ADDR 10 

CONS-IR-JUMP-COND CONS-JUMP-COND-UNC 

CONS-IR-P 1 

CONS-IR-N 1) 
(CC-EXECUTE (W-C-MEM 103) 

CONS-IR-STAT-BIT 1 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-JUMP-ADDR 100 

CONS-IR-M-SRC 22 

CONS-IR-A-SRC 1003 

CONS-IR-JUMP-COND CONS-JUMP-COND-M-A 

CONS-IR-N 1) 
(CC-EXECUTE (W-C-MEM 104) 

CONS-IR-OP CONS-OP-JUMP 

CONS-IR-JUMP-ADDR 100 

CONS-IR-JUMP-COND CONS-JUMP-COND-UNC 

CONS-IR-N 0) 
(CC-EXECUTE (W-C-MEM 105) 

CONS-IR-M-SRC 1 

CONS-IR-OB CONS-OB-ALU 

CONS-IR-M-MEM~DEST 1 

CONS-IR-ALUF CONS-ALU-M+1) 
) 

(defun display-registers-for-debug-divide-test () 

(cond ((variable-boundp d i spl ay -registers-for-debug-di vide- test-flag) 
(format T "~%A-MEM 1001 dividend ~A " (cc-read-a-mem 1001)) 
(format T "A-MEM 1002 divisor ~A~%" (cc-read-a~mem 1002)) 
(format T "A-MEM 1003 rem -A " (cc-read-a-mem 1003)) 
(format T "M-MEM 1 count ' ~A" (cc-read-m-mem 1)) 
(format T "~%M-1 -A " (cc-read-m-mem #o22)) 

(format T "A-2 «A" (cc~read-A-mem #o23)) 

(format T "~%Output Bus -A" (cc-read-obus))))) 

;(setq display-registars-for-debug-divide-test-flag T) 

;first arg of NIL says use values in machine. 

(DEFUN CC-DIVIDE-TEST-LOOP (&OPTIONAL (DIVIDEND (RANDOM 37777777)) 

(DIVISOR (RANDOM 37777777))) 
(LET ((REM (IF DIVIDEND (\ DIVIDEND DIVISOR)))) 

(CC-WRITE-M-MEM 1 0) ;error count 

(IF (NUMBERP DIVIDEND) 

(PROGN (CC-WRITE-A-MEM 1001 DIVIDEND) 
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(CC-WRITE-A-MEM 1002 DIVISOR) 

(CC-WRITE-A-MEM 1003 REM))) 
(CC-WRITE-STAT-COUNTER -40000.) ;times around loop 
(CC-RUN-TEST-LOOP 100) 
(CC-READ-M-MEM 1)) 
) 

(DEFUN CC-DIVIDE-SAVE-STATE NIL 

(LIST (CC-READ-A-MEM 1001) (CC-READ-A-MEM 1002) (CC-READ-A-MEM 1003))) 

(DEFUN CC-DIVIDE-RESTORE-STATE (STATE) 
(CC-WRITE-A-MEM 1001 (CAR STATE)) 
(CC-WRITE-A-MEM 1002 (CADR STATE)) 
(CC-WRITE-A-MEM 1003 (CADDR STATE))) 

(DEFUN CC-DIVIDE-COMPARE-STATE (STATE &AUX TEM) 

(IF (NOT (■ (SET'Q TEM (CC-READ-A-MEM 1001)) (CAR STATE))) 

(FORMAT T "~%1001 CLOBBERED FROM ~S TO ~S" TEM (CAR STATE))) 

(IF (NOT (- (SETQ TEM (CC-READ-A-MEM 1002)) (CADR STATE))) 

(FORMAT T "~%1002 CLOBBERED FROM ~S TO ~S" TEM (CADR STATE))) 

(IF (NOT (■ (SETQ TEM (CC-READ-A-MEM 1003)) (CADDR STATE))) 

(FORMAT T "~%1003 CLOBBERED FROM ~S TO -S" TEM (CADDR STATE)))) 

(comment 

(DEFUN CC-DIVIDE-TEST-LOOP-STATE NIL 

(LIST (CC-READ-A-MEM 1001) (CC-READ-A-MEM 1002))) ) 

(DEFUN CC-DIVIDE-RESTORE-STATE-AND-DIAGNOSE (S) 
(DBG-RESET) 
(CC-RESET-MACH) 
(CC-ZERO-ENTIRE-MACHINE) 
(CC-SETUP-DIVIDE-TEST) 

(APPLY (FUNCTION CC-DIVIDE-TEST-LOOP) S) 
(CC-DIVIDE-DIAGNOSE)) 

(DEFUN CC-DIVIDE-TEST '() 
(DO ((TEM)) (()) 

(IF (NOT (ZEROP (SETQ TEM (CC-DIVIDE-TEST-LOOP)))) 
(RETURN TEM)))) 



;use this if divide works at ultra slow speed and fails at normal speed. Args 

; that fail should already be loaded as per above test loop. 

;Running at ultra slow speed, this builds a table output-bus versus PC. 

;Then, running at normal speed, it samples machine and tries to find the 

; lowest PC where output bus has wrong thing. 

(DEFUN CC-DIVIDE-DIAGNOSE () 

(PROG (HIST PC OBUS INST TEM LOWEST-PC LOWEST-PC-OBUS GOOD-COMPARISONS BAD-COMPARISONS) 
(CC-SET-SPEED 0) 
(CC-COLON-START 100) 
(DOTIMES (C 1000) 
(CC-STOP-MACH) 

(SETQ PC (CC-READ-PC) OBUS (CC-READ-OBUS) INST (CC-READ-IR)) 
(IF (NOT (■ (L.DB C'ONS-IR-OP INST) CONS-OP-JUMP)) 
(IF (SETQ TEM (ASSQ PC HIST)) 

(IF (NOT (« (CDR TEM) OBUS)) 

(COMMENT (PROGN (FORMAT T "-"/.Multiple values observed at PC -0, -0 ~0 
PC OBUS (CDR TEM)) 
(CC-PRINT-BITS (LOGXOR OBUS (CDR TEM)))))) 
(SETQ HIST (CONS (CONS PC OBUS) HIST)))) 
(SPY-WRITE SPY-CLK 1)) ;continue 
(CC-STOP-MACH) 

(CC-SET-SPEED 2) ;normal 
(SPY-WRITE SPY-CLK 1) 

(SETQ GOOD-COMPARISONS BAD-COMPARISONS 0) 
(DOTIMES (C 1000) 
(CC-STOP-MACH) 
(SETQ PC (CC-READ-PC) OBUS (CC-READ-OBUS) INST (CC-READ-IR)). 
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(IF (NOT (- (LDB CONS-IR-OP INST) CONS-OP-JUMP)) 
(IF (SETQ TEM (ASSQ PC HIST)) 

(IF (NOT (- OBUS (CDR TEM))) 

(PROGN (SETQ BAD-COMPARISONS (1+ BAD-COMPARISONS)) 
(IF (OR (NULL LOWEST-PC) 
(< PC LOWEST-PC)) 
(SETQ LOWEST-PC PC LOWEST-PC-OBUS OBUS))) 
(SETQ GOOD-COMPARISONS (1+ GOOD-COMPARISONS))))) 
(SPY-WRITE SPY-CLK 1)) 
(CC-STOP-MACH) 
(IF LOWEST-PC 

(PROGN (FORMAT T "~%Lowest PC at error ~0, OBUS ~0, should be ~0" 

LOWEST-PC LOWEST-PC-OBUS (CDR (ASSQ LOWEST-PC HIST))) 
(FORMAT T "~%b1ts wrong ") 

(CC-PRINT-BITS (LOGXOR LOWEST-PC-OBUS (CDR (ASSQ LOWEST-PC HIST)))))) 
(FORMAT T "-"/.Length of HIST ~S , good comps ~S, bad comps ~S" 
(LENGTH HIST) GOOD-COMPARISONS BAD-COMPARISONS) 



)) 



;THIS DOESNT SEEM TO WORK JUST YET. 

(DEFUN CC-PDL-BUFFER-PUSH-POP-CHECK () . • 

(DBG-RESET) 
(CC-RESET-MACH) 
(CC-EXECUTE (W-C-MEM 100) 

CONS-IR-FUNODEST CQNS-FUNC-DEST-PDL-BUFFER-PUSH) 
(CC-EXECUTE (W-C-MEM 101) 

CONS-IR-M-SRC CONS-M-SRC-C-PDL-BUFFER-POINTER-POP) 
(CC-EXECUTE (W-C-MEM 10?,) 
CONS-IR-OP CONS-OP-JUMP 
CONS-IR-JUMP-ADDR 100 
CONS-IR-JUMP-COND CONS-JUMP-COND-UNC 
CONS-IR-N 1) 
(LET ((PP 1777) PC RPP INCR IR) 
(CC-WRITE-PDL-BUFFER-POINTER PP) 
(CC-SET-SPEED 2) 
(CC-COLON-START 100) 
(DOTIMES (C 1000) ; 

(CC-STOP-MACH) 
(SETQ PC (CC-READ-PC) 
IR (CC-READ-IR) 

RPP (CC~READ~PDL-BUFFER~POINTER)) 
(SETQ INCR (CDR (ASSQ PC * ((100 . 0) (101 . 1) (102 . 0) (103 . 0))))) 
(IF (NULL INCR) 

(FORMAT T "~%PC was random ~S" PC) 

(IF (NOT (* (LOGAND 1777 (+ PP INCR)) RPP)) 

(FORMAT T "~%PP Wrong, was ~0, should be ~0" RPP (LOGAND 1777 (+ PP INCR))))) 
(CC-WRITE-IR IR) 
(CC-WRITE-PC PC) 
(CC-CLOCK) 

(SPY-WRITE SPY-CLK 1)) ;CONTINUE 
')) 
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; ; ; Keyboard Tests 
(DEFVAR KEY-BITS 

*((#/4 11) 

(#\PLUS-MINUS 21) 

(ANETWORK 42) 

(AMACRO 100) 

(0/C 164))) 

(DEFVAR *TEST~LOCAL~KEYB0ARD* NIL) 
(DEFUN KEYBOARD-DBG-READ (ADR) 

(IF *TEST-LOCAL-KEYBOARD* (%UNIBUS-READ ADR) (DBG-READ ADR))) 

(DEFUN KEYBOARD-DBG-WRITE (ADR DATA) 

(IF *TEST-LOCAL-KEYBOARD* (%UNIBUS-WRITE ADR DATA) (DBG-WRITE ADR DATA))) 

(DEFUN TEST-IO-KEYBQARD () 

(KEYBOARD-DBG-READ 764100) ;C1ear out keyboard 

(IF (LDB-TEST 0501 (KEYBOARD-DBG-READ 764112)) 

(FORMAT T "~&Keyboard ready did not clear when read")) 
(DOLIST (L KEY-BITS) 

(APPLY 'TEST-KEY L)) 
) 

(DEFUN TEST-KEY (KEY VALUE) 

(FORMAT T "~&Hold down the ~:C key on the debugee and then type space on this keyboard." 

KEY) 
(SEND STANDARD-INPUT ' :TYI) 

(LET ((READ-KEY (KEYBOARD-DBG-READ 764100))) 
(IF (-Z READ-KEY VALUE) 

(FORMAT T "Keyboard should have been ~0 and was -0" VALUE READ-KEY)))) 

(DEFUN CC-TEST-IO-BOARD (^OPTIONAL (*TEST-LOCA-L-KEYBOARD* *TEST-L0CAL~KEY8QARD*) ) 

(FORMAT T "~&Testing Time of day clock") 

(CHECK-ANDS-AND-OR 764120 16. 1000. "Time of day") 

;; Enable remote mouse 

(KEYBOARD-DBG-WRITE 764112 1) 

(FORMAT T 

"~&Testing mouse Y direction, roll mouse upwards for a while 
and then type space") . 

(CHECK-ANDS-AND-OR 764104 12. NIL "Mouse Y position") 

(FORMAT T 

"~&Testing mouse X direction, roll mouse sideways for a while 
and then type space") 

(CHECK-ANDS-AND-OR 764106 12. NIL "Mouse X position") 

(FORMAT T "~&Testing console beeper, should be beeping") 

(LOOP DO (KEYBOARD-DBG-READ 764110) UNTIL (SEND STANDARD-INPUT ' : TYI-NO-HANG)) 

(FORMAT T "-^Testing Chaosnet interface") 

(LET ( (CHAOS .'CHATST-USE-DEBUG (NOT *TE5T-L0CAL-KEYB0ARD*))) 
(CHAOS :CHATST))) 

(DEFUN CHECK-ANDS-AND-OR (ADDR BITS ITERATION NAME) 
(LET* ((MASK (1- (* 2 BITS))) 
(AND MASK) 
(OR 0)) 
(DO ((I (1+ I)) 
(RES)) 
((IF (NULL ITERATION) 

(SEND STANDARD-INPUT ': TYI-NO-HANG) 
( A ] I ITERATION))) 
(SETQ RES (LOGAND MASK (KEYBOARD-DBG-READ ADDR)) 
OR (LOGIOR OR RES) 
AND (LOGAND AND RES))) 
(IF (OR (*Z AND 0) ( A Z OR MASK)) 

(FORMAT T "~&B1ts in the ~A register not changing. ~% L0GAND--0 LOGI0R-~0" 
NAME AND OR)))) 

(DEFCONST *SERIAL-IO-TESTS* 

*(((:BAUD 1200.) (:PARITY :OTJD) 
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NUMBER-OF-DATA-BITS 7) ( : NUMBER-OF-STOP-BITS ?.)) 

BAUD 9600.) (: PARITY ;EVEN) 

NUMBER-OF-DATA-BITS 8) ( : NUM8ER-0F-ST0P-BITS 1)))) 



(SETQ STREAM (SI 
(DOLIST (PROP ' ( 



(DEFUN TEST-SERIAL-IO () 
(LET ((STREAM NIL)) 
(UNWIND-PROTECT 
(PROGN 

:MAKE-SERIAL-STREAM 
NUMBER-OF-STOP-BITS 1 
PARITY ' :ODD)) 

:CHECK-PARITY-ERRORS :CHECK-OV£R-RUN-ERRORS :CHECK-FRAMING-ERRORS)) 
(FUNCALL STREAM ' : PUT PROP T)) 
(FORMAT T "~&Testing serial I/O using /"remote loop back/" in the UART.") 
(UNWIND-PROTECT 
(PROGN 

(FUNCALL STREAM ' : PUT ' : LOCAL-LOOP-BACK T) 
(TEST-SERIAL-IO-SERIES STREAM *SERIAL~IO-TESTS*) ) 
(FUNCALL STREAM ':PUT ': LOCAL-LOOP-BACK NIL)) 
(FORMAT T "~2&Attach a loop-back plug; type N if you don't want to do this test, 
or any other character to run the r test.") 

(LET ((CHAR (SEND STANDARD-INPUT * :TYI))) 
(COND ((NOT (CHAR-EQUAL ti/U CHAR)) 

(FORMAT T "~&Testing extra EIA-RS-232 bits.") 
(TEST-SERIAL-IO-EIA-RS-232-BITS STREAM) 
(TEST-SERIAL-IO-SERIES STREAM *SERIAL~IO-TESTS*) ) ) )) 
(CLOSE STREAM)))) 

(DEFVAR *SERIAL~IQ-ERROR-COUNT*) 
(DEFCONST *SERIAL-IO-ERR0R-LIMIT* 5) 

(DEFUN TEST-SERIAL-IO-SERIES (STREAM SERIES) 
(DOLIST (TEST SERIES) 
(LET ((BASE 10.) 
(FIRST T) 

(*SERlAL-IO-ERROR-COUNT* 0)) 
(FORMAT T "~&") 
(DOLIST (CLAUSE TEST) 

(LET ((NAME (FIRST CLAUSE)) 

(VALUE (SECOND CLAUSE))) 
(IF (NOT FIRST) 

(FORMAT T "; ")) 
(SETQ FIRST NIL) 
(FORMAT T "~S - ~S" NAME VALUE) 
(FUNCALL STREAM ':PUT NAME VALUE))) 
(TEST-SERIAL-IO-CHARS STREAM)))) 

(DEFCONST *SERIAL-IO-TIMEOUT* 60.) 

(DEFUN TEST-SERIAL-IO-CHARS (STREAM) 

(DOTIMES (SENT-CHAR (* 2 (FUNCALL STREAM ' :GET ' :NUMBER-OF-DATA~BITS) ) ) 
(FUNCALL STREAM ' : TYO SENT-CHAR) 

(COND ((PROCESS-WAIT-WITH-TIMEOUT "Serial In" *SERIAL-IO-TIMEOUT* STREAM ' :LISTEN) 
(LET ((GOT-CHAR (FUNCALL STREAM ' :TYI))) 
(COND ((NOT '(- SENT-CHAR GOT-CHAR)) 

(FORMAT T "~&Error: sent ~0 and got back -0 (both octal )~%" 

SENT-CHAR GOT-CHAR) 
(INCF *SERIAL-IO-ERROR-COUNT*) 

(COND ((< *SERIAL-IO-ERROR-COUNT* *SERlAL-IO-ERROR-LIMIT*) 
(FORMAT T "«&Status of serial I//0 line:~%") 
(SI:SERIAL-STATUS))))))) 
(T 

(FORMAT T "~&Error: timed out waiting for character ~Q (octal )~%" 
SENT-CHAR))))) 

;;; Unfortunately, you can't read back clear-to-send (the LM-2 Serial I/O 
;;; documentation is wishful thinking). 
(DEFUN TEST-SERIAL-I0-EIA-RS-232--BITS (STREAM) 

(LOOP FOR SET IN '(: DATA-TERMINAL-READY : DATA-TERMINAL-READY) 



